lisp, generowanie kierunków/grotów strzałek na zadanej polilinii


alf
 Share

Recommended Posts

Poszukuję szybkiego rozwiązania (np lispa, w necie takiego nie znalazłam lub linii specjalnej, ale to się chyba w cadzie nie da..) do wstawiania strzałek kierunkowych na zadanej polilinii:  konkretnie w środku długości pojedynczego jej odcinka. Ze względu na różnorodność przypadków dobrze było by by lisp do generowania "grotów" miał możliwość:

1. Ustalenia skali rysunku (w stosunku do jednostki podstawowej, zadeklarowanej w "units") na której wstawia się kierunek (np mapy, dla których units ustawiam na "m" są w róznych skalach, np  1:1000, 1:50 000) - ale nie koniecznie, jesli to klopot, bo jesli strzalka bedzie blokiem to sprawa przeskalowania grupy bloków jest prosta

2. pomijanie odcinków, których długość jest mniejsza od wielokrotności długości grotu np >3x długość strzałki (strzałki na krótkich odcinkach są bez sensu) - tu potrzebna jest skala wstawienia

3. forma strzalki to chyba najlepiej rodzaj bloku (prosty grot z wypełnieniem, calosc by block), bo latwiej podmienic blok na inny blok, lub wprowadzić jakąs nietypową skalę, gdyby ktoś chciał jakąś dziwaczną strzałkę.

4. Środek ciężkości bloku/punkt wstawienia = środek odcinka polilinii  -by "ładnie" wyglądały wygenerowane kierunki

z góry dziękuję za pomoc..

 

image.thumb.png.ae2a33d3ae81405c4b78ff0dfa57732d.png

 

Link to comment
Share on other sites

.. no własnie nie do końca..

chodzi o multum polilinii, do których trzeba by dołożyć symbole kierunków, a lisp LZS to klikanie strzałkami po każdym odcinku.. do us--ej śmierci można klikać i klikać..

ponieważ to jest rodzaj schematu, strzałki powinny być konkretne by schemat na "przeciętnego" użytkownika był czytelny. Dlatego pytałam o szybsze rozwiązanie, dla którego podałam ideę działania..

zwcad nie jest w stanie o ile wiem wygenerować rodzaju linii tak by za każdym razem na środku odcinka polilinii wstawiał zadany symbol a nie co jakiś odcinek.. stąd pomysł o rozmieszczenia bloku grotu strzałki na środku odcinka. Takiego lispa nie znalazłam, a sama lispowac nie umiem.. 

 

Link to comment
Share on other sites

19 godzin temu, alf napisał:

Poszukuję szybkiego rozwiązania

Bardzo proszę o podesłania kawałka rysunku, zastanowimy się jak ułatwić to zadanie ze wstawianiem bloków.

Rozumiem, że na każdym odcinku pollinii ma być wstawiony tylko jeden blok w jego środku, chyba, że odcinek jest zbyt krótki?

 

Link to comment
Share on other sites

tak na szybko:

divide i measure - nie.. tzn tak, ale "ładny" tj prosty i czytelny schemat z tego nie będzie..  dlatego bloki na środku odcinka z pomijaniem odcinków zbyt krótkich. i nie pomysl np z wstawianiem trójkąta z polilinii z wycięciem tego co w środku, bo wtedy demoluje się polilinię (kiedyś taki lisp widziałam).. jak chce się "wyciąć" linię to można przykryć to hatchem lub wipeoutem - może to nie jest piękne ale Polilinia cała..

oczywiście lista bloków różnych "arrow" to jedno a co w tych blokach siedzi (można to przecież podmieniać) to drugie. Zresztą lista bloków może być długa jak ktoś potrzebuje może do listy dorobić następne bloki dwg dla innych bardziej fikuśnych strzałek

ważne żeby pomijać odcinki na których dany typ kierunku się po prostu nie mieści. O tyle lepiej bloki a nie np jakiś wymiar, tak przynajmniej mi się wydaje, że z wymiarami różnie bywa, a blok to stabilny obiekt jeśli chodzi o "wędrówki" między różnymi programami

i ważne żeby blok wstawiać na aktualnej warstwie. Warstwy w bloku  powinny też być "unikatowe", żeby nie było nakładania na ist warstwy w rysunkach. w zał pliku nazwy elementów w bloku są niby unikatowe ale nie  do końca.. , to można zmienić  na coś bardziej nietypowego

wielkość strzałek - rzecz gustu, tu są dość małe, bo dużo polilinii leci blisko siebie, ale jak schemat był by bardziej ogólny, można strzałki dac większe, to kwestia współczynnika skali..

Drawing1111.dwg

Link to comment
Share on other sites

Zadanie z tych banalnych raczej... Można rozwiązać tak:

; ---------------------------------------------------------------------------- ;
(defun c:testuj ()(InsBlkInPolySeg (car (entsel)) "arrow1" 20.0 15.0)(princ))
; ---------------------------------------------------------------------------- ;
; funkcja zwraca liste segmentow LWPOLY typu: ((p1 bulge1 p2)(p2 bulge2 p3)...);
; ---------------------------------------------------------------------------- ;
(defun jk:LWP_GetSegments (e / p d r)
  (setq d (entget e)
        p (if
             (= 1 (logand (cdr (assoc 70 d)) 1))
             (cdr (assoc 10 d))
           )
        d (mapcar 'cdr
            (vl-remove-if-not
              '(lambda (%)(member (car %) '(10 42)))
              d
            )
          )
  )
  (if p
    (setq d (append d (list p)))
  )
  (while
    (> (length d) 2)
    (setq r (cons
                (list
                  (car d)
                  (cadr d)
                  (caddr d)
                ) r
              )
          d (cddr d)
    )
  )
  (reverse r)
)
; ---------------------------------------------------------------------------- ;
(defun InsBlkInPolySeg (Poly Block Scale MinLength / d b n a p)
  (if
    (not (tblobjname "BLOCK" Block))
    (princ
      (strcat
        "\nBłąd: w rysunku nie ma bloku "
        (strcase Block) "."
      )
    )
    (if
      (not
        (setq d (jk:LWP_GetSegments Poly))
      )
      (princ "\nBłąd - niepoprawna Polilinia.")
      (if
        (not
          (setq d
            (vl-remove-if-not '(lambda (%)(zerop (cadr %))) d)
          )
        )
        (princ "\nBłąd - polilinia składa sie z samych łuków.")
        (if
          (not
            (setq d
              (vl-remove-if
                '(lambda (%)
                   (< (distance (car %)(caddr %)) MinLength)
                ) d
              )
            )
          )
          (princ "\nBłąd - segmenty polilinii są za krótkie.")
          (progn
            (cd:SYS_UndoBegin)
            (foreach % d
              (setq a (angle (car %)(caddr %))
                    p (polar (car %) a (/ (distance (car %)(caddr %)) 2.0))
              )
              (cd:BLK_InsertBlock p Block (list Scale Scale Scale) a nil)
            )
            (cd:SYS_UndoEnd)
          )
        )
      )
    )
  )
)
; ---------------------------------------------------------------------------- ;

Polecenie TESTUJ, wywołuje funkcję InsBlkInPolySeg, dla której jednak kluczem jest funkcja jk:LWP_GetSegments. Dla całości trzeba CADPL-Pack-a który opisywałem kiedyś tutaj: https://kojacek.wordpress.com/2015/11/04/cadpl-pack/ . W uproszczeniu - groty strzałek w postaci bloku (argument Block) wstawiane są na liniowych segmentach wskazanej polilinii (argument Block - tutaj trzeba wstawić jeszcze jakieś testowanie wyboru), których długość jest większa niż argument MinLength.

insblkinpolysec.gif

Link to comment
Share on other sites

Wywołałam wilka z lasu...

Dziękuję twórcy, właśnie na strone "kojacek" znalazłam różne ciekawe "bajery" dla oznaczania kierunków, ale ten chyba najfajniejszy niestety fas,

Pytanie, choć mi na razie zbędne, lisp nie wstawi grota na części plinii tj łuku, i tak samo będzie ze splajnami połaczonymi w pl?

Czy nie dało by się dorobić do lispa pobierania bloku grota jaki wybór z rysunku, jakie uproszczone zagranie: wstawiamy wybrany grot do schematu, skalujemy go odpowiednio do skali przygotowywanego schematu a potem właśnie ten przeskalowany wybieramy do wstawiania na dają polilinię

PS.. Może i banał, ale ja w lispowych sprawach jestem ciemna masa..

Link to comment
Share on other sites

7 godzin temu, alf napisał:

Wywołałam wilka z lasu...

Dziękuję twórcy, właśnie na strone "kojacek" znalazłam różne ciekawe "bajery" dla oznaczania kierunków, ale ten chyba najfajniejszy niestety fas,

Pytanie, choć mi na razie zbędne, lisp nie wstawi grota na części plinii tj łuku, i tak samo będzie ze splajnami połaczonymi w pl?

Czy nie dało by się dorobić do lispa pobierania bloku grota jaki wybór z rysunku, jakie uproszczone zagranie: wstawiamy wybrany grot do schematu, skalujemy go odpowiednio do skali przygotowywanego schematu a potem właśnie ten przeskalowany wybieramy do wstawiania na dają polilinię

PS.. Może i banał, ale ja w lispowych sprawach jestem ciemna masa..

Przedstawiony kod dotyczy tak zwanej "lekkiej polilinii" czyli obiektu typu LWPOLYLINE, a makro oczywiście (i rzeczywiście) "omija" segmenty łukowe. Polilinia której segmenty są splajnami, jest automatycznie konwertowana na ("stary") obiekt i jest typu POLYLINE, więc na tych obiektach kod nie działa. Krótko (ale mam nadzieję) w jasny sposób parę słów o polilinich znajdziesz (reklama) tu: https://kojacek.wordpress.com/2015/09/18/polilinie-2d/

Jeśli chodzi o rozwój przedstawionego rozwiązania. Sugerowałbym aby blok grota, był blokiem dynamicznym (z kilkoma trybami widoczności), co uprościłoby wszelkie zabawy z tymże - zamiast przebierać w setkach (możliwych przecież) bloków w rysunku, brać jeden i wybierać potrzebny stan widoczności. Idea bloków dynamicznych właśnie (choć nie tylko) sprawdza się doskonale w takich sytuacjach.

PS. w avatarze jest wrona, nie wilk... 😉

Edited by kojacek
Link to comment
Share on other sites

Jak sugeruje @kojacek myślę, że dobrze żeby blok strzałki był blokiem dynamicznym. Można mu zadać zarówno skalę, jak i widoczność (różne groty) jak i parametr align. Wtedy na ewentualnym łuku ustawiałoby się to ręcznie. Zresztą skalę bloku można zmienić przez select similar/qselect i po prostu we właściwościach bloku ją zmienić. 

Link to comment
Share on other sites

Tak, tylko, że wchodzimy w ten sposób w sferę tabu. Co prawda mam "swój" sposób na tworzenie prostych boków dynamicznych, ale chodziło w mojej wypowiedzi o prostotę lispa i odporność jego na wynalazki z patentem, za którego wykorzystanie bez zgody i wiedzy wiadomokogo grozi krzesło elektryczne.

Nie mniej jednak nawet w postaci jw, lisp już stał się super przydatny..  reszte załatwić można na kilka innych lispo-sposobów

Link to comment
Share on other sites

Jedni dziobią, inni drapią a ja .... hm. Takie mam:

Polecenie do uruchomienia

zzz

 

(defun C:zzz (  / symb Polilinia
     *error* )    (defun *error* ( msg / )
         (if (not (null msg ) )    (progn (princ "\nC:zzz:*error*: " ) (princ msg ) (princ "\n")    ) )
     )
    (setq symb ( SelSet:Entsel "Wybierz strzałkę" (list (cons 0 "INSERT" ))) )
    (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) )
    (while (not (null polilinia ) )
        (wstawWSrodkuOdcinkow polilinia symb)    
        (setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) )
    )
    (princ)
)
 
(defun wstawWSrodkuOdcinkow ( polilinia symb / ile i
     *error* )    (defun *error* ( msg / )
         (if (not (null msg ) )    (progn (princ "\nwstawWSrodkuOdcinkow:*error*: " ) (princ msg ) (princ "\n")    ) )
     )
     (setq ile (vlax-curve-getEndParam polilinia ) )
     (setq i 1 )
     (repeat (fix ile)
        (if (not (odcinekJestzbytkrotki polilinia i symb )) (progn
            (wstawWOdcinku polilinia i symb)
        ) )
        (setq i (1+ i) )
     )
)
 
(defun odcinekJestzbytkrotki ( polilinia i symb / d1 d0 dlugoscodcinka wielkoscsymbolu
     *error* )    (defun *error* ( msg / )
         (if (not (null msg ) )    (progn (princ "\nodcinekJestzbytkrotki:*error*: " ) (princ msg ) (princ "\n")    ) )
     )
     (setq d1(vlax-curve-getDistAtParam polilinia i))
     (setq d0(vlax-curve-getDistAtParam polilinia (- i 1 ) ) )
     (setq dlugoscodcinka (- d1 d0 ) )
     (setq wielkoscsymbolu ( BoundingBox:Width ( BoundingBox symb ) ) )
     (< dlugoscodcinka (* 3 wielkoscsymbolu) )
)

(defun wstawWOdcinku ( polilinia i symb / midparam px nowysymbol P0 ang
    *error* )    (defun *error* ( msg / )
        (if (not (null msg ) )    (progn (princ "\nwstawWOdcinku:*error*: " ) (princ msg ) (princ "\n")    ) )
    )
    (setq midparam (- i 0.5) )
    (setq px (vlax-curve-getPointAtParam polilinia midparam ) )
    (setq nowysymbol (vlax-invoke-method symb 'Copy ) )
    (setq P0 (vlax-get-property nowysymbol 'InsertionPoint ) )
    (vlax-invoke-method nowysymbol 'Move P0 (vlax-3d-point px ) )
    (setq ang (vlax-curve-getFirstDeriv polilinia midparam) )
    (vlax-put-property nowysymbol 'Rotation (angle (list 0 0 0 ) ang ) )
    nowysymbol
)


(defun SelSet:Entsel (tresc filter / OldNoMutt MSel OutVal
 *error* )     (defun *error* ( msg / )
        (if (not (null msg ) )    (progn (princ "\nSelSet:Entsel:*error*: " ) (princ msg ) (princ "\n")    ) )
    )      

    (setq tresc (strcat "\n" tresc ": ") )
    (prompt tresc )
    
    (setq OldNoMutt (getvar 'NOMUTT))    
    (setvar 'NOMUTT 1)    
    (setq MSel
        (if (null filter)
            (vl-catch-all-apply 'ssget (list ":S:E" ))
            (vl-catch-all-apply 'ssget (list ":S:E" filter ))
        )
    )
        
    (setvar 'NOMUTT OldNoMutt )
    (if (vl-catch-all-error-p MSel)
    (progn
        (prompt (vl-catch-all-error-message MSel))
    )
    (progn
      (if MSel (progn        
        (setq OutVal (vlax-ename->vla-object  (ssname MSel 0)) )            
      ))
    )
    )
    OutVal
)


(defun BoundingBox (object / width height IP AP P1 P2 MoveVector
    *error*)     (defun *error* ( msg / )
        (if (not (null msg ) )    (progn (princ "\n BoundingBox : *error*: " ) (princ msg ) (princ "\n")    ) )
    )        
    (if (Object:IsErased object ) (*error* "object is erased" ))
    (setq ans(vl-catch-all-apply 'vlax-invoke-method (list object 'GetBoundingBox 'P1 'P2 )))
    (if (vl-catch-all-error-p ans )  (progn
        (print ( vl-catch-all-error-message ans ) )
        )
        (progn
            (setq P1 (List:Factory P1 ) )
            (setq P2 (List:Factory P2 ) )
        )
    )
    (list P1 P2 )
)


(defun BoundingBox:Width ( bbox /
    *error*)     (defun *error* ( msg / )
        (if (not (null msg ) )    (progn (princ "\n BoundingBox:Width : *error*: " ) (princ msg ) (princ "\n")    ) )
    )       
    (- (car (cadr bbox) ) (car (car bbox) ))
)


(defun List:Factory (InVal / OutVal AsList     ; (setq mem InVal )        (setq InVal mem )
  *error*)     ( defun *error* ( msg / )
        (if (not (null msg ) )    (progn (princ "\nList:Factory :*error*: " ) (princ msg ) (princ "\n")    ) )
    )     
    
    (cond
        ( ( = (type InVal) nil) nil)
        ( (vl-catch-all-error-p InVal) (progn (princ "Error trapped:" ) (princ InVal ) nil))
        ( ( = (type InVal) 'LIST) InVal)
        ( ( = (type InVal) 'SAFEARRAY) (progn            
            (setq AsList (vl-catch-all-apply 'vlax-safearray->list (list InVal )))
            (if (vl-catch-all-error-p AsList)   ( progn
                ( princ (vl-catch-all-error-message AsList ) )
                nil
              )  ( progn
                AsList
            ) )
        ) )
        ( ( = (type InVal) 'VARIANT) (progn
            (List:Factory (vlax-variant-value InVal) ) ; bo variant value powinien zwrócić safearray
        ) )        
        ( t (list InVal ) )
    )
)
 
 (defun Object:IsErased ( obj / blockHandle
    *error*)     (defun *error* ( msg / )
        (if (not (null msg ) )    (progn (princ "\n  Object:IsErased: *error*: " ) (princ msg ) (princ "\n")    ) )
    )
    (setq result nil)
    (if (null obj )
        (setq result T)
        (progn
            (setq blockHandle (vlax-get-property obj 'handle ))
            (if  (null blockHandle )
                (setq result T)
                (progn
                    (setq entity (handent blockHandle) )
                    (if  (null entity )
                        (setq result T)
                        (setq result (null (entget entity ) ))
                    )
                )
            )
        )
    )
    result
)

 

 

strzałki.gif

Strzałki.lsp

Link to comment
Share on other sites

oznaczenie kierunku różnych rzeczy, w np hydraulice (czyli kanalizacji) - kierunku przepływu.. ale też w różnych schematach blokowych.. 

a co do lispa - i właśnie o to szło, prostota i wszechstronna użyteczność. A to tego jakby się dodało wstawianie innych bloków na końcach (podpuszczam.. :-)), wyszedł by z tego cudny kanał 

image.thumb.png.019710defbf5122bb1539b485475039f.png

 

Link to comment
Share on other sites

OK, dorobiłem drugą funkcję, która wstawia symbole w załamaniach polilini

nową funkcję można uruchomić poleceniem
 

opisz

 



(defun C:zzz (  / symb Polilinia 
	 *error* )	(defun *error* ( msg / ) 
		 (if (not (null msg ) )	(progn (princ "\nC:zzz:*error*: " ) (princ msg ) (princ "\n")	) )
	 )
	(setq symb ( SelSet:Entsel "Wybierz strzałkę" (list (cons 0 "INSERT" ))) )
	(setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) )
	(while (not (null polilinia ) )
		(wstawWSrodkuOdcinkow polilinia symb)	 
		(setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) )
	)
	(princ)
)


(defun C:opisz (  / symb polilinia 
	 *error* )	(defun *error* ( msg / ) 
		 (if (not (null msg ) )	(progn (princ "\nC:zzz:*error*: " ) (princ msg ) (princ "\n")	) )
	 )
	(setq symb ( SelSet:Entsel "Wybierz symbol" (list (cons 0 "INSERT" ))) )
	(setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) )
	(while (not (null polilinia ) )
		(wstawWZalamaniach polilinia symb)	 
		(setq polilinia ( SelSet:Entsel "Wybierz polilinię" (list (cons 0 "*POLYLINE" ))) )
	)
	(princ)
)
 
(defun wstawWSrodkuOdcinkow ( polilinia symb / ile i 
	 *error* )	(defun *error* ( msg / ) 
		 (if (not (null msg ) )	(progn (princ "\nwstawWSrodkuOdcinkow:*error*: " ) (princ msg ) (princ "\n")	) )
	 )
	 (setq ile (vlax-curve-getEndParam polilinia ) )
	 (setq i 1 )
	 (repeat (fix ile) 
		(if (not (odcinekJestzbytkrotki polilinia i symb )) (progn
			(wstawWOdcinku polilinia i symb)
		) )
		(setq i (1+ i) )
	 )
)

 
(defun odcinekJestzbytkrotki ( polilinia i symb / d1 d0 dlugoscodcinka wielkoscsymbolu 
	 *error* )	(defun *error* ( msg / ) 
		 (if (not (null msg ) )	(progn (princ "\nodcinekJestzbytkrotki:*error*: " ) (princ msg ) (princ "\n")	) )
	 )
	 (setq d1(vlax-curve-getDistAtParam polilinia i))
	 (setq d0(vlax-curve-getDistAtParam polilinia (- i 1 ) ) )
	 (setq dlugoscodcinka (- d1 d0 ) )
	 (setq wielkoscsymbolu ( BoundingBox:Width ( BoundingBox symb ) ) )
	 (< dlugoscodcinka (* 3 wielkoscsymbolu) )
)

(defun wstawWOdcinku ( polilinia i symb / midparam px nowysymbol P0 ang
	*error* )	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nwstawWOdcinku:*error*: " ) (princ msg ) (princ "\n")	) )
	)
	(setq midparam (- i 0.5) )
	(setq px (vlax-curve-getPointAtParam polilinia midparam ) )
	(setq nowysymbol (vlax-invoke-method symb 'Copy ) )
	(setq P0 (vlax-get-property nowysymbol 'InsertionPoint ) )
	(vlax-invoke-method nowysymbol 'Move P0 (vlax-3d-point px ) )
	(setq ang (vlax-curve-getFirstDeriv polilinia midparam) )
	(vlax-put-property nowysymbol 'Rotation (angle (list 0 0 0 ) ang ) )
	nowysymbol
)

(defun wstawWZalamaniach ( polilinia symb / ile i 
	 *error* )	(defun *error* ( msg / ) 
		 (if (not (null msg ) )	(progn (princ "\nwstawWSrodkuOdcinkow:*error*: " ) (princ msg ) (princ "\n")	) )
	 )
	 (setq ile (vlax-curve-getEndParam polilinia ) )
	 (setq i 0 )
	 (repeat (1+(fix ile) )
		(wstawWZalamaniu polilinia i symb)
		(setq i (1+ i) )
	 )
)

(defun wstawWZalamaniu ( polilinia i symb / px nowysymbol P0 ang
	*error* )	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nwstawWOdcinku:*error*: " ) (princ msg ) (princ "\n")	) )
	)
	(setq px (vlax-curve-getPointAtParam polilinia i ) )
	(setq nowysymbol (vlax-invoke-method symb 'Copy ) )
	(setq P0 (vlax-get-property nowysymbol 'InsertionPoint ) )
	(vlax-invoke-method nowysymbol 'Move P0 (vlax-3d-point px ) )
	(setq ang (vlax-curve-getFirstDeriv polilinia i) )
	(vlax-put-property nowysymbol 'Rotation (angle (list 0 0 0 ) ang ) )
	nowysymbol
)


(defun SelSet:Entsel (tresc filter / OldNoMutt MSel OutVal 
 *error* ) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nSelSet:Entsel:*error*: " ) (princ msg ) (princ "\n")	) )
	)      

	(setq tresc (strcat "\n" tresc ": ") )
	(prompt tresc )
	
	(setq OldNoMutt (getvar 'NOMUTT))	
	(setvar 'NOMUTT 1)	
	(setq MSel
		(if (null filter)
			(vl-catch-all-apply 'ssget (list ":S:E" ))
			(vl-catch-all-apply 'ssget (list ":S:E" filter ))
		)
	)
		
	(setvar 'NOMUTT OldNoMutt )
	(if (vl-catch-all-error-p MSel)
	(progn
		(prompt (vl-catch-all-error-message MSel))
	)
	(progn
	  (if MSel (progn		
		(setq OutVal (vlax-ename->vla-object  (ssname MSel 0)) )			
	  ))
	)
	)
	OutVal
)


(defun BoundingBox (object / width height IP AP P1 P2 MoveVector 
	*error*) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\n BoundingBox : *error*: " ) (princ msg ) (princ "\n")	) )
	)        
	(if (Object:IsErased object ) (*error* "object is erased" ))
	(setq ans(vl-catch-all-apply 'vlax-invoke-method (list object 'GetBoundingBox 'P1 'P2 )))
	(if (vl-catch-all-error-p ans )  (progn
		(print ( vl-catch-all-error-message ans ) )
		)
		(progn
			(setq P1 (List:Factory P1 ) )
			(setq P2 (List:Factory P2 ) )
		)
	)
	(list P1 P2 )
)


(defun BoundingBox:Width ( bbox / 
	*error*) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\n BoundingBox:Width : *error*: " ) (princ msg ) (princ "\n")	) )
	)       
	(- (car (cadr bbox) ) (car (car bbox) ))
)


(defun List:Factory (InVal / OutVal AsList 	; (setq mem InVal )		(setq InVal mem )
  *error*) 	( defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nList:Factory :*error*: " ) (princ msg ) (princ "\n")	) )
	)     
	
	(cond 
		( ( = (type InVal) nil) nil)
		( (vl-catch-all-error-p InVal) (progn (princ "Error trapped:" ) (princ InVal ) nil))
		( ( = (type InVal) 'LIST) InVal)
		( ( = (type InVal) 'SAFEARRAY) (progn			
			(setq AsList (vl-catch-all-apply 'vlax-safearray->list (list InVal )))
			(if (vl-catch-all-error-p AsList)   ( progn
				( princ (vl-catch-all-error-message AsList ) )
				nil
			  )  ( progn 
			    AsList
			) )
		) )
		( ( = (type InVal) 'VARIANT) (progn 
			(List:Factory (vlax-variant-value InVal) ) ; bo variant value powinien zwrócić safearray
		) )		
		( t (list InVal ) )
	)
)
 
 (defun Object:IsErased ( obj / blockHandle
	*error*) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\n  Object:IsErased: *error*: " ) (princ msg ) (princ "\n")	) )
	)
	(setq result nil)
	(if (null obj ) 
		(setq result T) 
		(progn
			(setq blockHandle (vlax-get-property obj 'handle ))
			(if  (null blockHandle ) 
				(setq result T)
				(progn
					(setq entity (handent blockHandle) )
					(if  (null entity ) 
						(setq result T)
						(setq result (null (entget entity ) ))
					)
				)
			)
		)
	)
	result
)

 

Strzałki.lsp

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
 Share