Forum użytkowników programów ZWCAD, KOMPAS-3D, Scan2CAD, PDF2CAD

[Kuba1]

Mam taki lisp. Podobno pod AC działa. Ale pod ZW jakoś nie bardzo.
Generalnie w lispie chodzi o to żeby zaznaczyć tylko kółka kiedy wybierzemy np wszystko co jest na rysunku, a potem żeby wyciąć to co jest wewnątrz tych kółek.
Dal wtajemniczonych jest to pewnie bardzo proste, ale jak się LISPa nie zna to niestety...

LISP wygląda tak:
(defun C:CIRCTRIM (/ ss ll osm)
(if (not etrim)(load "extrim" 1))
(if
(setq ss (ssget '((0 . "CIRCLE"))))
(progn
(setq ll (jk:SSX_SS->List ss)
osm (getvar "osmode")
)
(setvar "osmode" 0)
(foreach % ll
(etrim % (cdr (assoc 10 (entget %))))
)
(setvar "osmode" osm)
)
)
)
(defun jk:SSX_SS->List (sel / % l)
(repeat
(setq % (sslength sel))
(setq % (1- %)
l (cons (ssname sel %) l)
)
)
)


Kóleczka wybiera jak powinien, ale potem klops.
Generalnie linia poleceń wygląda tak:

Polecenie: circtrim
Wybierz obiekty:
Obiektow w zbiorze: 1
Wybierz obiekty:
błąd: pusta funkcja
(ETRIM (CDR (ASSOC 10 (ENTGET ))))
(FOREACH (ETRIM (CDR (ASSOC 10 (ENTGET )))))
(PROGN (SETQ LL (JK:SSX_SS->LIST SS) OSM (GETVAR "osmode")) (SETVAR "osmode" 0) (FOREACH (ETRIM (CDR (ASSOC 10 (ENTGET ))))) (SETVAR "osmode" OSM))
(IF (SETQ SS (SSGET (QUOTE ((0 . "CIRCLE"))))) (PROGN (SETQ LL (JK:SSX_SS->LIST SS) OSM (GETVAR "osmode")) (SETVAR "osmode" 0) (FOREACH (ETRIM (CDR (ASSOC 10 (ENTGET ))))) (SETVAR "osmode" OSM)))
(C:CIRCTRIM)

Ma ktoś pomysł co jest nie tak???

[kruszynski]

W programie użyta jest funkcja etrim.
(if (not etrim)(load "extrim" 1))
powinno spowodować, że funkcja ta zostanie wczytana a pliku "extrim". Proszę się upewnić czy ma Pan plik extrim.lsp w katalgu widocznym przez ZWCADa, czyli w katalogu samego programu, lub w którymś z katalogów ustawionych w opcjach ZWCADa.

[Assgarth]

Funkcja "extrim" związana jest z Express Tools (ET) AutoCAD'a.
Możliwe, że jest alternatywna wersja w ZwCAD...

EDIT: możesz też zastąpić tę funkcję inną funkcję napisaną w Lisp.
np. http://forums.autodesk.co.../1514962/page/2

pozdrawiam,
Assgarth

[kruszynski]

W ZWCAD również jest dostępna funkcja Extrim. jednak w załączonym kodzie jest ETRIM bez X. Więc albo autor łaskaw był napisać własną funkcję która się nazywa ETRIM i zapisał ją w pliku extrim albo przy kopiowaniu kodu komuś się X nie skopiował, ale żeby 2 razy?

[Assgarth]

[kruszynski]

OK. polecenie ZWCADa, Extrim takie do wpisania w linii poleceń jest. funkcji możliwej do wykorzystania w programie lispowym, rzeczywiście brak. Skonsultujemy z ZWSOFT czy jest możliwość zaimportowania poleceń ExpresTools jakoś inaczej. Jako rozwiązanie tymczasowe może Pan spróbować zmienić :
(etrim w linii ;(etrim % (cdr (assoc 10 (entget %))))
na
(command "Extrim"
.

[Kuba1]

W sumie to mogło by być zastępcze. Tyle, że nie działa.

Polecenie: circtrim
Wybierz obiekty:
Przeciwlegly naroznik:
Obiektow w zbiorze: 1
Wybierz obiekty:
Polecenie: Extrim
Polecenie: <Entity name: 8c7deb0>
Polecenie:
Polecenie: (-1099.25 937.945 0.000000)
0
Polecenie:

Może coś skopałem???

[Kuba1]

No i nikt nic nie wymyśli

[Assgarth]

Zmiana postaci polecenia, na nic się nie przydaje - ZwCAD w tym poleceniu, przy wywołaniu z poziomu LISP'a, po prostu nie działa...

Kod:

(defun C:CIRCTRIM (/ ss ll osm) (if (not etrim)(load "extrim" 1)) (if (setq ss (ssget '((0 . "CIRCLE")))) (progn (setq ll (jk:SSX_SS->List ss) osm (getvar "osmode") ) (setvar "osmode" 0) (foreach % ll ;(etrim % (cdr (assoc 10 (entget %)))) (command "_.extrim" % (cdr (assoc 10 (entget %)))) ) (setvar "osmode" osm) ) ) ) (defun jk:SSX_SS->List (sel / % l) (repeat (setq % (sslength sel)) (setq % (1- %) l (cons (ssname sel %) l) ) ) )

Taki zapis również nie przynosi efektu:

Kod:

(command "_extrim" (car(entsel)) "" (getpoint "\Wskaż punkt: "))

Jeśli nie Masz za dużo tych kółek do obrobienia, to po prostu ręcznie je sobie poucinaj poleceniem "_extrim".
Jeśli jest tego bardzo dużo, to proponuję poszukać funkcji tnących obiektów z obiektami (google: "break" "trim" etc.).

pozdrawiam

[Kuba1]

Rzecz w tym, że mam kilkaset na jednym rysunku, a rysunków obrabiam kilka do kilkunastu dziennie. Gdybym miał jednorazowo powiedzmy nawet 500, to bym sobie ani innym nie zawracał głowy tylko poucinał ręcznie.
Z drugiej strony - wydawało mi się, że skoro dla AC to parę linijek lispu i dla kogoś, kto "w tym siedzi" to do napisania między jednym łykiem kawy a drugim, to i w ZW będzie proste, łatwe i przyjemne. Jakkolwiek widzę, że nie do końca. Chociaż jak mi się wydaje z logicznego punktu widzenia, a i podpartego jeszcze wspomnieniami z pisania prostych programów w pascalu, to jakiś szał to raczej nie jest - trzeba stworzyć zbiór kółek, nawet bez funkcji zaznaczania (bo przecież zaznaczyć to ja je sobie mogę poleceniem GETSEL chociażby) i pętlę (pewnie z tym poleceniem extrim), które w kółku pokazuje punkt wewnętrzny (to nawet chyba można zrobić bardzo prosto - przez wskazanie środka) i potem następne kółko z listy.
Trochę mnie zasmuciło, że to w ZW jakiś problem. Ale trzeba w każdej sytuacji szukać dobrych stron - a dobra to taka, że w chwili wolnej (ha ha - ciekawe kiedy) po prostu siądę i pouczę się tego lispa. Obstawiam, że po dniu roboczym nauki sam taki lisp napiszę.

[Kuba1]

A właściwie na skutek (póki co bardzo krótkich) prób nauki LISPa doszedłem do wniosku, że ten lisp mógłby być nieco inny i chyba prostszy do napisania. Lisp mógłby (a może nawet lepiej by to było) ucinać obiekty (linie i łuki - innych obiektów nie musi, a nawet i z łuków mógłbym zrezygnować) na których znajduje się środek okręgu (to by pewnie znacznie ułatwiło samo wskazanie punktu). Może komenda TRIM w tym wypadku by się mogła sprawdzić? Może jakaś inna. Poza tym może pomogło by gdyby te kółka były np blokami. Póki co nie wiem.
Miałem taką wizję, że skoro w AC jest LISP EXTRIM (z poleceniem ETRIM - tu się wyjaśnia skąd to cudo się wzięło), to da się prosto go przerobić na LISP pod ZW , przy okazji usuwając co niepotrzebne (a jest co), zmieniając może nazwę samego lispu (nie wiem czy to potrzebne, ale w sumie niczemu nie szkodzi, więc można zmienić). Niestety ten chytry plan trochę nie wyszedł. Trochę wiedzy na temat samych komend w LISPie jest potrzebnych, a póki co znam kilka oi nie do końca jeszcze umiem poprawnie ich użyć.
A może ktoś się skusi na próbę dostosowania?
;Extended-TRIM - cookie-cutter routine
;
;Select a polyline, line, circle or arc and a side to trim on
;
(defun c:extrim ( / na e1 p1 redraw_it lst n )

(acet-error-init (list
(list "cmdecho" 0
"highlight" 0
"regenmode" 1
"osmode" 0
"ucsicon" 0
"offsetdist" 0
"attreq" 0
"plinewid" 0
"plinetype" 1
"gridmode" 0
"celtype" "CONTINUOUS"
"ucsfollow" 0
"limcheck" 0
)
T ;flag. True means use undo for error clean up.
'(if redraw_it (redraw na 4))
);list
);acet-error-init


(princ "\nPick a POLYLINE, LINE, CIRCLE, ARC, ELLIPSE, IMAGE or TEXT for cutting edge...")
(setq na (acet-ui-single-select '((-4 . "<OR")
(0 . "CIRCLE")
(0 . "ARC")
(0 . "LINE")
(0 . "ELLIPSE")
(0 . "ATTDEF")
(0 . "TEXT")
(0 . "MTEXT")
(0 . "IMAGE")
(0 . "SPLINE")
(0 . "INSERT")
(0 . "SOLID")
(0 . "3DFACE")
(0 . "TRACE")
(0 . "LWPOLYLINE")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<NOT")
(-4 . "&")
(70 . 112)
(-4 . "NOT>")
(-4 . "AND>")
(-4 . "OR>")
)
T
);acet-ui-single-select
);setq
(if na
(progn
(setq e1 (entget na));;setq
(if (or (equal "TEXT" (cdr (assoc 0 e1)))
(equal "MTEXT" (cdr (assoc 0 e1)))
(equal "ATTDEF" (cdr (assoc 0 e1)))
(equal "IMAGE" (cdr (assoc 0 e1)))
(equal "INSERT" (cdr (assoc 0 e1)))
(equal "SOLID" (cdr (assoc 0 e1)))
(equal "3DFACE" (cdr (assoc 0 e1)))
(equal "TRACE" (cdr (assoc 0 e1)))
);or
(progn
(setq lst (acet-geom-object-point-list na nil))
(setq n 0)
(command "_.pline")
(repeat (length lst)
(command (nth n lst))
(setq n (+ n 1));setq
);repeat
(if (not (equal (car lst) (last lst) 0.0000001))
(command "_cl")
(command "")
);if
(setq na (entlast)
e1 na
);setq
);progn then draw a temp pline to be the cutting edge.
(setq e1 nil)
);if
(redraw na 3)
(setq redraw_it T)

(setq p1 (getpoint "\nSpecify the side to trim on:"));setq
(redraw na 4)
(setq redraw_it nil)
(if p1 (etrim na p1));if
(if e1
(progn
(if (setq p1 (acet-layer-locked (getvar "clayer")))
(command "_.layer" "_un" (getvar "clayer") "")
);if
(entdel e1)
(if p1
(command "_.layer" "_lock" (getvar "clayer") "")
);if
);progn then
);if
);progn
);if

(acet-error-restore)
(princ)
);defun c:extrim

;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;Entity-TRIM function
;takes: na - entity name
; a - a point, the side to trim on
;NOTE: This function does not allow for the possible miss of
; non-continuous linetypes.
;
(defun etrim ( na a / la b d e1 lst lst2 n j k m ss na2 na3 na4
x y z flag flag2 flag3 zlst vpna vplocked
)


(setq e1 (entget na));setq
(if (or (setq flag (equal (acet-dxf 0 e1) "POLYLINE"))
(setq flag (equal (acet-dxf 0 e1) "LWPOLYLINE"))
(equal (acet-dxf 0 e1) "LINE")
(equal (acet-dxf 0 e1) "CIRCLE")
(equal (acet-dxf 0 e1) "ARC")
(equal (acet-dxf 0 e1) "ELLIPSE")
(equal (acet-dxf 0 e1) "TEXT")
(equal (acet-dxf 0 e1) "ATTDEF")
(equal (acet-dxf 0 e1) "MTEXT")
(equal (acet-dxf 0 e1) "SPLINE")
);or
(progn
(if (and flag
(equal 8 (logand 8 (acet-dxf 70 e1)))
);and
(setq flag nil)
);if
(setq a (trans a 1 0)
vpna (acet-currentviewport-ename)
);setq
(acet-ucs-cmd (list "_View"))

(setq lst (acet-geom-object-point-list na nil) ;;;find extents of selected cutting edge object
lst (acet-geom-list-extents lst)
x (- (car (cadr lst)) (car (car lst)))
y (- (cadr (cadr lst)) (cadr (car lst)))
x (* 0.075 x)
y (* 0.075 y)
z (list x y)
x (list (+ (car (cadr lst)) (car z))
(+ (cadr (cadr lst)) (cadr z))
);list
y (list (- (car (car lst)) (car z))
(- (cadr (car lst)) (cadr z))
);list
zlst (zoom_2_object (list x y))
);setq
(if vpna
(setq vplocked (acet-viewport-lock-set vpna nil)) ;unlock cur viewport if needed.
);if
(command "_.zoom" "_w" (car zlst) (cadr zlst))

(entupd na) ;;;update the ent. so it's curves display smoothly

(setq lst (acet-geom-object-point-list na
(/ (acet-geom-pixel-unit) 2.0)
)
);setq
(if (or (not flag)
(not (acet-geom-self-intersect lst nil))
);or
(progn ;then the object is valid and not a self intersecting polyline.
(if (and flag
(equal (car lst) (last lst) 0.0001)
);and
(setq flag3 T);then the polyline could potentialy need a second offset
);if
(if (setq la (acet-layer-locked (getvar "clayer")))
(command "_.layer" "_unl" (getvar "clayer") "")
);if

(command "_.pline")
(setq b nil)
(setq n 0);setq
(repeat (length lst)
(setq d (nth n lst))
(if (not (equal d b 0.0001))
(progn
(command d)
(setq lst2 (append lst2 (list d)));setq
(setq b d);setq
);progn
);if
(setq n (+ n 1))
);repeat
(command "")
(setq na2 (entlast)
ss (ssadd)
ss (ssadd na2 ss)
lst nil
);setq
(acet-ss-visible ss 1)
(setq lst2 (get_fence_points na2 a lst2 flag3 flag));setq

(if la
(command "_.layer" "_lock" (getvar "clayer") "")
);if
(acet-ucs-cmd (list "_p"))
;Move the ents to force a display update of the ents to avoid viewres problems.
(setvar "highlight" 0)
(if (setq ss (ssget "_f" (last lst2)))
(command "_.move" ss "" "0,0,0" "0,0,0")
);if
(if flag
(progn
(if (setq la (acet-layer-locked (acet-dxf 8 e1)))
(command "_.layer" "_unl" (acet-dxf 8 e1) "")
);if
(acet-ucs-set-z (acet-dxf 210 e1))
(command "_.copy" na "" "0,0,0" "0,0,0")
;(entdel na)
(acet-ss-visible (ssadd na (ssadd)) 1);make it invisible for a while.
;rk 12:01 PM 3/10/98
(setq na3 na
na (entlast)
);setq
(command "_.pedit" na "_w" "0.0" "_x")
(acet-ucs-cmd (list "_p"))
(if la (command "_.layer" "_lock" (acet-dxf 8 e1) ""));if
);progn
);if
(command "_.trim" na "")
(setq m (- (length lst2) 1));setq
(setq k 0)
(repeat (length lst2)
(setq lst (nth k lst2))
(setq a (trans (car lst) 0 1))
(setq n 1)
(repeat (- (length lst) 1) ;repeat each fence list
(setq b (trans (nth n lst) 0 1))
(if (equal a b 0.0001)
(setq flag2 T)
(setq flag2 nil)
);if
(setq na4 nil);setq
(setq j 0);setq
(while (not flag2) ;repeat each segment of the fence until no new ents are created.
(setq na4 (entlast));setq
(command "_F" a b "")
(if (and (equal na4 (entlast))
(or (not (equal k m))
(> j 0)
);or
);and
(setq flag2 T)
);if
(setq j (+ j 1));setq
);while
(setq a b);setq
(setq n (+ n 1));setq
);repeat

(setq k (+ k 1))
);repeat
(command "")

(if flag
(progn
(if (setq la (acet-layer-locked (acet-dxf 8 e1)))
(command "_.layer" "_unl" (acet-dxf 8 e1) "")
);if
(entdel na) ;get rid of the copy

;(entdel na3);bring back the original
(acet-ss-visible (ssadd na3 (ssadd)) 0) ;bring back the original
;rk 12:01 PM 3/10/98
(if la (command "_.layer" "_lock" (acet-dxf 8 e1) ""));if
);progn
);if
);progn
(progn
(acet-ucs-cmd (list "_p"))
(princ "\nSelf intersecting edges are not acceptable.")
);progn else invalid self intersecting polyline
);if
(command "_.zoom" "_p")
(if vplocked
(acet-viewport-lock-set vpna T) ;then re-lock the viewport
);if
);progn then it's a most likely a valid entity.
);if
);defun etrim

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun another_offset ( pl1 pl2 a1 a2 b na2 lst2 a lst3 lst4 / na ss lst da1 da2)

(setq da1 (abs (- a2 a1)));setq
(setq da2 (- (* b (max pl2 pl1))
(/ (* b (abs (- pl2 pl1)))
2.0
)
)
);setq
(if (> (abs (- da2 da1))
(* 0.01 (max a1 a2))
)
(progn

(acet-pline-make (list lst2))
(setq na (entlast)
na2 (entlast)
ss (ssadd)
ss (ssadd na ss)
);setq
(acet-ss-visible ss 1)
(command "_.offset" b na2 a "")
(if (and (not (equal na (entlast)))
(setq lst3 (acet-geom-vertex-list (entlast)))
(setq lst3 (intersect_check lst2 lst3 lst4))
);and
(progn
(acet-ss-visible (ssadd (entlast) (ssadd)) 1)
(command "_.area" "_ob" (entlast))
(setq pl2 (getvar "perimeter")
a2 (getvar "area")
);setq
(setq lst (list (acet-geom-vertex-list (list (entlast) 0))));setq
(entdel (entlast));then offset was a success so delete the ent after getting it's info
);progn then
(if (not (equal na (entlast))) (entdel (entlast)));if else
);if
(entdel na2)
);progn then let's do that second offset
);if

lst
);defun another_offset

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_fence_points ( na2 a lst2 flag plflag / a1 a2 pl1 pl2 b c d n
lst lst2 lst3 lst4 na
)

(if flag
(progn
(setq lst2 (cdr lst2));setq
(repeat (fix (/ (length lst2) 2))
(setq lst2 (append (cdr lst2) (list (car lst2)));append
);setq
);repeat
(setq lst2 (append lst2 (list (car lst2))));setq
(command "_.area" "_ob" na2)
(setq pl1 (getvar "perimeter")
a1 (getvar "area")
);setq
);progn
);if

(setq a (trans a 0 1)
b (* (getvar "viewsize") 0.05);initial offset distance
n 3.0 ;number of offsets
d (/ b (- n 1)) ;delta offset
c (acet-geom-pixel-unit)
lst4 (acet-geom-view-points)
);setq

(while (> b c)
(setq na (entlast))
(command "_.offset" b na2 a "")
(if (and (not (equal na (entlast)))
(setq lst3 (acet-geom-vertex-list (entlast)))
(or (not plflag)
(setq lst3 (intersect_check lst2 lst3 lst4))
);or
);and
(progn
(setq lst3 (acet-geom-m-trans lst3 1 0))
(acet-ss-visible (ssadd (entlast) (ssadd)) 1)
(if flag
(progn
(command "_.area" "_ob" (entlast))
(setq pl2 (getvar "perimeter")
a2 (getvar "area")
);setq
);progn
);if
(setq lst (append lst (list lst3)));setq
(entdel (entlast)) ;delete the ent after getting it's vertex info
(if flag
(setq lst (append lst
(another_offset pl1 pl2 a1 a2 b na2 lst2 a lst3 lst4)
);append
);setq
);if
);progn then offset was a success
(if (not (equal na (entlast))) (entdel (entlast)));if else
);if
(setq b (- b d));setq
);while
(setq na (entlast))
(command "_.offset" c na2 a "")
(if (and (not (equal na (entlast)))
(setq lst3 (acet-geom-vertex-list (entlast)))
(or (not plflag)
(setq lst3 (intersect_check lst2 lst3 lst4))
);or
);and
(progn
(setq lst3 (acet-geom-m-trans lst3 1 0))
(acet-ss-visible (ssadd (entlast) (ssadd)) 1)
(if flag
(progn
(command "_.area" "_ob" (entlast))
(setq pl2 (getvar "perimeter")
a2 (getvar "area")
);setq
);progn
);if
(setq lst (append lst (list lst3)));setq
(entdel (entlast));then offset was a success so delete the ent after getting it's info
(if flag
(setq lst (append lst
(another_offset pl1 pl2 a1 a2 c na2 lst2 a lst3 lst4)
);append
);setq
);if
);progn then
(if (not (equal na (entlast))) (entdel (entlast)));if else
);if
(entdel na2)

lst
);defun get_fence_points

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;returns a list of points on screen if the first two lists do not
;contain segments that intersect each other.
;
(defun intersect_check ( lst lst2 lst3 / x x2 y y2 lst4 flag len len2
a aa b bb c d n j)

(setq len (length lst)
len2 (length lst2)
x (car (car lst3))
x2 (car (cadr lst3))
y (cadr (car lst3))
y2 (cadr (cadr lst3))
);setq

(setq n 0);setq
(while (and (not flag)
(< (+ n 1) len2)
);and
(setq aa (nth n lst2)
bb (nth (+ n 1) lst2)
a (bns_truncate_2_view aa bb x y x2 y2)
b (bns_truncate_2_view bb aa x y x2 y2)
lst4 (append lst4 (list a))
);setq
(if (or (not (equal a aa))
(not (equal b bb))
);or
(setq lst4 (append lst4 (list b)))
);if
(setq j 0);setq
(while (and (not flag)
(< (+ j 1) len)
);and
(setq c (nth j lst)
d (nth (+ j 1) lst)
flag (inters a b c d)
);setq

(setq j (+ j 1));setq
);while

(setq n (+ n 1));setq
);while
(if (not (equal b (last lst4)))
(setq lst4 (append lst4 (list b)));setq
);if
(if (not flag)
(setq flag lst4)
(setq flag nil)
);if
flag
);defun intersect_check

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zoom_2_object ( lst / p1 p2 p3 p4 p5 p6 mp dx dy dx2 dy2
r1 r2 na e1 x w h dv1 dv2 x
)

(setq lst (acet-geom-m-trans lst 1 2)
p1 (acet-geom-m-trans (acet-geom-view-points) 1 2) ;p1 and p2 are the viewpnts
p2 (cadr p1)
p1 (car p1)
p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
);setq
(if lst
(progn
(setq p5 (acet-geom-list-extents lst) ;p5 and p6 are the geometry points
p6 (cadr p5)
p5 (car p5)
p5 (list (car p5) (cadr p5))
p6 (list (car p6) (cadr p6))
mp (acet-geom-midpoint p5 p6) ;prepare to resize the geometry rectang to
dx (- (car p2) (car p1)) ;have the same dy/dx ratio as p1 p2.
dy (- (cadr p2) (cadr p1))
dx2 (- (car p6) (car p5))
dy2 (- (cadr p6) (cadr p5))
);setq
(if (equal dx 0.0) (setq dx 0.000001)) ;just in case div by zero
(if (equal dx2 0.0) (setq dx2 0.000001))
(setq r1 (/ dy dx)
r2 (/ dy2 dx2)
);setq
(if (< r2 r1)
(setq dy2 (* r1 dx2));then scale dy2 up
(progn
(if (equal r1 0.0) (setq r1 0.000001)) ;just in case div by zero
(setq dx2 (* dy2 (/ 1.0 r1)));else scale dx2 up
);progn
);if
(setq p5 (list (- (car mp) (/ dx2 1.98)) ;1.98 is used instead of 2.0 to expand
(- (cadr mp) (/ dy2 1.98)) ;the rectangle slightly
);list
p6 (list (+ (car mp) (/ dx2 1.98))
(+ (cadr mp) (/ dy2 1.98))
);list
);setq
);progn then lst
);if
(if (and lst
(equal 0 (getvar "tilemode"))
(not (equal 1 (getvar "cvport")))
(setq na (acet-currentviewport-ename))
);and
(progn
(setq e1 (entget na)
x (cdr (assoc 10 e1))
w (cdr (assoc 40 e1))
h (cdr (assoc 41 e1))
p3 (list (- (car x) (/ w 2.0))
(- (cadr x) (/ h 2.0))
);list
p4 (list (+ (car x) (/ w 2.0))
(+ (cadr x) (/ h 2.0))
);list
p3 (trans p3 3 2) ;p3 and p4 are the viewport points
p4 (trans p4 3 2)
dv1 (acet-geom-delta-vector p1 p3)
dv2 (acet-geom-delta-vector p2 p4)
x (distance p1 p2)
);setq
(if (equal 0 x) (setq x 0.000001));just in case
(setq x (/ (distance p5 p6)
x
)
dv1 (acet-geom-vector-scale dv1 x)
dv2 (acet-geom-vector-scale dv2 x)
p5 (acet-geom-vector-add p5 dv1)
p6 (acet-geom-vector-add p6 dv2)
);setq
);progn then
);if
(setq p1 (list (car p1) (cadr p1) 0.0)
p2 (list (car p2) (cadr p2) 0.0)
p5 (list (car p5) (cadr p5) 0.0)
p6 (list (car p6) (cadr p6) 0.0)
);setq
(if lst
(setq lst (list (trans p5 2 1)
(trans p6 2 1)
);list
);setq
(setq lst nil)
);if

lst
);defun zoom_2_object


(princ)

[Assgarth]

Cytat:

Z drugiej strony - wydawało mi się, że skoro dla AC to parę linijek lispu i dla kogoś, kto "w tym siedzi" to do napisania między jednym łykiem kawy a drugim, to i w ZW będzie proste, łatwe i przyjemne.

W AC jest parę linijek kodu, bo istnieje już gotowa biblioteka ET, która wykonuje "brudną" robotę. Poza tym kod który wkleiłeś, pokazuje jak wiele obliczeń i analiz związane jest z nimy trywialnym zagadnieniem.

Cytat:

Trochę mnie zasmuciło, że to w ZW jakiś problem.

Nie spodziewaj się, że kupisz produkt o 10 razy tańszy i jednocześnie tak samo "wypasiony".

Cytat:

A może ktoś się skusi na próbę dostosowania?

Jak ktoś dysponuje wolną chwilą, to może się tym zajmie. Weź jednak pod uwagę, że robienie dla samego robienia, nikogo nie pociąga... Musisz uzbroić się w cierpliwość.
W przedstawionym przez Ciebie kodzie, jest masę funkcji, które również odwołują się bezpośrednio do ET, którego w ZwCAD nie ma. Funkcje trzeba czymś zastąpić.
Natomiast Twój pomysł na użycie funkcji TRIM jest realny, lecz wymaga zupełnie innego podejście do tematu i przeprowadzenia wielu analiz (wbrew pozorom).

pozdrawiam,
Assgarth

[Kuba1]

No to smutno
Czy ten AC taki wypasiony? No nie wiem.
Wszystko by był proste i szybkie, gdyby polecenie EXTRIM działało spod LISPA w ZW.
Co do dostosowywania ałtokadowego LISPa Extrim - ja się nie znam, jak bym się znał, to pewnie bym dostosował. Chociaż tam jest masa funkcji i strzelam, że większość całkiem do niczego w tym wypadku nie potrzebnych. Jak się wykasuje co niepotrzebne może się okazać, że trzeba zmienić jedną linijkę.
Z tym, że "robienie dla samego robienia" zdaje się pociąga niektórych. Tak np kolega z forum cad.pl robi "dla samego robienia".
I w jego przypadku to jest dokładnie "robienie dla samego robienia", bo widać, że on ma obcykanego LISPa pod AC do bólu. Z takim trochę rozczarowaniem powiem, że Wy niestety nie macie - biorąc po uwagę porady, które nie działają i np stwierdzenie, że trzeba "przeprowadzić wiele analiz". Toż to ja pytam o prosty LISP a nie o projekt statku kosmicznego.
"Robić dla samego robienia" -
W sumie to cały czas mi się wydawało, że forum jest po to żeby radzić, pomagać itd.
Ja z samej potrzeby sprawdzenia siebie i swoich umiejętnośći bym te parę linijek napisał w "międzyczasie" gdyby oczywiście umiał.
I widzę, że pewnie zostało mi się "naumieć" albo zażądać możliwości pracy na programie, na którym nie ma takich problemów. Między ZW a AC LT (bryły mi do niczego - do 3d używam programów, które się do tego nadają) już takiej przepaści cenowej nie ma (a przynajmniej akceptowalna) a ET dla AC LT istnieje jak się okazuje (można doinstalować).

[Assgarth]

Cytat:

Toż to ja pytam o prosty LISP a nie o projekt statku kosmicznego.

Widać, że nie bardzo się orientujesz nie tylko w samym Lisp, ale również ogólnie w programowaniu. To, że coś wydaje się proste w użyciu, nie znaczy, że jest równie proste w oprogramowaniu...

Cytat:

W sumie to cały czas mi się wydawało, że forum jest po to żeby radzić, pomagać itd.

No i otrzymałeś informacje, porady, ale nie licz, że od razu ktoś usiądzie i będzie programował funkcje - czas to pieniądz.

Kod:

Tak np kolega z forum cad.pl robi "dla samego robienia".

Zatem zgłoś się do "kolegi", albo cierpliwie poczekaj aż ktoś inny znajdzie tę chwilę.

Cytat:

Między ZW a AC LT (...) już takiej przepaści cenowej nie ma (a przynajmniej akceptowalna) a ET dla AC LT istnieje jak się okazuje (można doinstalować).

I tutaj po raz kolejny pokazujesz, że nie Masz pojęcia co w trawie piszczy.
Sam Express Tools nie rozwiąże sprawy w przypadku gdy potrzebujesz użyć LISP'a, bo w AutoCAD LT, Lisp nie jest aktywny...

[Kuba1]

Robi się nieco pyskówka, ale...
To, że się nie orientuję w LISP, to napisałem - jestem zielony jak oślisko na polu. Ale...
Ale kiedyś, za czasów studiów programów prostych, które mi się przydawały na studiach trochę popełniłem i zdaję sobie sprawę, że jak się coś umie , to się umie i że mając wiedzę na temat LISP da się ten lisp bardzo szybko.
Informacje i porady jakie dostałem są żadne - po pierwsze nie sprawdzone, bo nie działają, po drugie nie prowadzą do niczego poza pyskówką - LISPA jak nie miałem tak nie mam.
Jak w ogóle ocenić porady typu - "to po prostu ręcznie je sobie poucinaj", "proponuję poszukać funkcji tnących obiektów z obiektami (google: "break" "trim" etc.)" - toż Panowie myślą, że nie szukałem?
A już porada "Taki zapis również nie przynosi efektu:" to jest mistrzostwo świata.
Toż ja sam mogę podać 100milionów zapisów, które nie przynoszą efektu.
Nawet porada typu - weź i się sam naucz + jakieś naprowadzenie jak się do tego konkretnego LISPa zabrać (porada typu "wymaga zupełnie innego podejście do tematu i przeprowadzenia wielu analiz" nie jest żadną poradą) było by czymś co by może pomogło.
Może bym się i zatem zgłosił do kolegi z forum cad.pl gdyby nie to, że on pisze LISPy pod AC (nie ZW) - i takowy stworzył mi w mgnieniu oka. Zwracam się o pomoc na forum ZWCADa o LISP do ZWCADa - chyba logicznie.
Ja nie szaleję i nie mam jakichś uwag do poczekania na pomoc. Jakkolwiek nikt jakby wprost takiej pomocy (w napisaniu LISPu) nie zaproponował.
A co do piszczenia w trawie i LISPa pod LT to kolega już całkiem popłynął.
Ja sobie bardzo dobrze zdaję sprawę, że LISP pod LT nie jest aktywny.
Zdaję sobię też sprawę z tego , że są programy, dzięki którym można go pod LT używać.

Wniosek z całego bajdurzenia jest taki - Panowie macie takie prawie samo pojęcie jak ja, tyle, że ja się nie mądruję na temat rzeczy, o których wiem niewiele.

I to by chyba było na zakończenie, bo w sumie szukać tu i tak nie ma czego.