TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: matrix2005in on June 01, 2006, 10:26:25 AM
-
Hi there
i am looking for a lisp for :roll:
1) join multiple 3dpolylines
2) offset 3dpolylines
thanks
-
3D Offset
http://www.theswamp.org/index.php?topic=1425.msg17839#msg17839
This one was one of my first lisp routines so don't look too closely at it.:)
;; Routine to convert 3d lines to as few as possable 3d polylines
;; CAB 12/23/03
;;
;; Collect all lines into a selection set
;; Create a list of end points
;; Walk through end points and find matches
;; Create a list of points then make into plines
;;
(defun c:3dp (/ sslines lc ssl lep en end end1 end2 ptr 3dll pt)
(if (setq sslines (ssget "X" '((0 . "LINE"))))
(prompt "\nWorking, Please Wait.")
(progn
(prompt "\nNo Lines Found. ")
(exit)
)
)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(setvar "osmode" 0)
(setq lc 0
ssl (sslength sslines)
lep (list)
3dcnt 0 ; # of 3d lines
fuzz 0 ; change as needed
)
(prompt (strcat "\n" (rtos (/ ssl 2) 2 0) " lines found."))
(command "undo" "begin")
(while (< lc ssl) ; make a list of line end points
(setq en (entget (ssname sslines lc))
lep (cons (cdr (assoc 11 en)) lep)
lep (cons (cdr (assoc 10 en)) lep)
lc (1+ lc)
) ; inc pointer
) ; end while
(while lep
;; lep is a collection of line end points
(setq end1 (car lep) ; get one end
end2 (cadr lep) ; get the other end
lep (cddr lep) ; remove that line from list
3dll (list)
3dll (cons end2 3dll)
3dll (cons end1 3dll); 3dll is the first segment of 3d poly line
ptr 0 ; pointer
)
;;
(while (<= (1+ ptr) (length lep))
(setq end (nth ptr lep)) ; get a line end point from list
(cond
((equal end end1 fuzz) ; found a matching point
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
;; get pevious point
(setq 3dll (cons (nth (1- ptr) lep) 3dll); add to begining of 3dll
end1 (car 3dll)
lep (remove_pt (1- ptr) ptr)
) ; remove the end points from the list
;; else begining of line
;; get next point
(setq 3dll (cons (nth (1+ ptr) lep) 3dll)
end1 (car 3dll)
lep (remove_pt ptr (1+ ptr))
) ; remove the end points from the list
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 1
((equal end end2 fuzz)
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
;; get pevious point
(setq 3dll (append 3dll (list (nth (1- ptr) lep))); add to end of 3dll
end2 (nth (1- ptr) lep)
lep (remove_pt (1- ptr) ptr)
)
;; else begining of line
;; get next point
(setq 3dll (append 3dll (list (nth (1+ ptr) lep)))
end2 (nth (1+ ptr) lep)
lep (remove_pt ptr (1+ ptr))
)
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 2
(t
(setq ptr (1+ ptr)) ; inc pointer
)
) ; end cond stmt
) ; end while
;;;=====================================================
;;; Draw 3d poly here using points collected in 3dll
;;;=====================================================
(if 3dll
(progn
(command "3dpoly")
(foreach pt 3dll
(command pt)
)
(command "")
(setq 3dcnt (1+ 3dcnt))
)
); endif
) ; end while
(command "_erase" sslines "")
(command "undo" "end")
(prompt (strcat "\n" (rtos 3dcnt 2 0) " 3dPoly lines created."))
(prompt "\nProcess complete.\n")
(setvar "osmode" useros)
(setvar "CMDECHO" usercmd)
) ; end defun main
(defun remove_pt (first sec / cnt llen newlist)
(setq cnt 0
llen (length lep)
newlist (list)
)
(while (< cnt llen)
(if (and (/= cnt first) (/= cnt sec))
(setq newlist (cons (nth cnt lep) newlist))
)
(setq cnt (1+ cnt))
); end while
(reverse newlist)
); end defun
-
HI CAB
:-(
3dp is converting lines to 3dpoly
offset3d is do not offset 3dpoly...it will work with polyline,line etc..and offset to z elevaton..
actually i am looking for
1) join multipple 3DPOLYLINE (like lwpolyline joining using pedit)
2) offset 3DPOLYLINE
thanks
-
How about exploding your existing 3D polys into lines then use CAB's function. Problem solved :?
-
Here is my "offset3dpoly":
;;Routine to offset 3Dpolylines
;;Jeff Mishler, April 2005
(defun c:offset3d (/ coords doc idx newcoords newpoly obj offdist offs space ss tmp tmpcoords)
(setq doc (vla-get-activedocument (vlax-get-acad-object))
space (if (= (getvar "cvport") 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
offdist (getdist "\nOffset distance, (negative to left, positive to right): ")
)
(while (setq ss (ssget ":S" '((0 . "POLYLINE")(-4 . "&=")(70 . 8))))
(setq obj (vlax-ename->vla-object (ssname ss 0))
coords (vlax-get obj 'coordinates)
)
(setq tmp (vlax-invoke space 'addpolyline coords)
offs (vlax-invoke tmp 'offset offdist)
)
(setq tmpcoords (vlax-get (car offs) 'coordinates)
idx 0
newcoords nil)
(if (= (length coords) (length tmpcoords))
(progn
(repeat (length coords)
(if (= (rem idx 3) 2)
(setq newcoords (append newcoords (list (nth idx coords))))
(setq newcoords (append newcoords (list (nth idx tmpcoords))))
)
(setq idx (1+ idx))
)
(setq newpoly (vlax-invoke space 'add3dpoly newcoords))
(vla-put-layer newpoly (vla-get-layer obj))
(vla-put-color newpoly (vla-get-color obj))
(vla-put-linetype newpoly (vla-get-linetype obj))
)
(princ "\n....Unable to offset that 3dPoly.")
)
(vla-delete tmp)
(vla-delete (car offs))
)
(princ)
)
-
excellent jeff thats very nice.....
thanks man
what about 3d poly join?? :-)
-
Hello
anyone please?? :cry: :cry:
-
How about you start it, and then post back when you are stuck or you have finished the routine. When/If you are stuck, people will help you past that part.
-
hi
3dpoly offset is working fine..........actually there was two question..one is offset and other is joining..thats y i asked again...if some one can help me for joining 3dpolyline also..
thanks all
-
Hello
anyone please?? :cry: :cry:
Do you really want to learn how to write code, by following all the advise from all the talented programmers that frequent the swamp?
Please, read this url link:
http://www.theswamp.org/index.php?topic=2621.0
-
Just adding some _ (underscore)...
;; Routine to convert 3d lines to as few as possable 3d polylines
;; CAB 12/23/03
;;
;; Collect all lines into a selection set
;; Create a list of end points
;; Walk through end points and find matches
;; Create a list of points then make into plines
;; Modified by AndreaLISP for Language version compatibilitie June 1 2006
(defun c:3dp (/ sslines lc ssl lep en end end1 end2 ptr 3dll pt)
(if (setq sslines (ssget "X" '((0 . "LINE"))))
(prompt "\nWorking, Please Wait.")
(progn
(prompt "\nNo Lines Found. ")
(exit)
)
)
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq useros (getvar "osmode"))
(setvar "osmode" 0)
(setq lc 0
ssl (sslength sslines)
lep (list)
3dcnt 0 ; # of 3d lines
fuzz 0 ; change as needed
)
(prompt (strcat "\n" (rtos (/ ssl 2) 2 0) " lines found."))
(command "_undo" "_begin")
(while (< lc ssl) ; make a list of line end points
(setq en (entget (ssname sslines lc))
lep (cons (cdr (assoc 11 en)) lep)
lep (cons (cdr (assoc 10 en)) lep)
lc (1+ lc)
) ; inc pointer
) ; end while
(while lep
;; lep is a collection of line end points
(setq end1 (car lep) ; get one end
end2 (cadr lep) ; get the other end
lep (cddr lep) ; remove that line from list
3dll (list)
3dll (cons end2 3dll)
3dll (cons end1 3dll); 3dll is the first segment of 3d poly line
ptr 0 ; pointer
)
;;
(while (<= (1+ ptr) (length lep))
(setq end (nth ptr lep)) ; get a line end point from list
(cond
((equal end end1 fuzz) ; found a matching point
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
;; get pevious point
(setq 3dll (cons (nth (1- ptr) lep) 3dll); add to begining of 3dll
end1 (car 3dll)
lep (remove_pt (1- ptr) ptr)
) ; remove the end points from the list
;; else begining of line
;; get next point
(setq 3dll (cons (nth (1+ ptr) lep) 3dll)
end1 (car 3dll)
lep (remove_pt ptr (1+ ptr))
) ; remove the end points from the list
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 1
((equal end end2 fuzz)
(if (/= (/ ptr 2.0) (fix (/ ptr 2.0))) ; end of line
;; get pevious point
(setq 3dll (append 3dll (list (nth (1- ptr) lep))); add to end of 3dll
end2 (nth (1- ptr) lep)
lep (remove_pt (1- ptr) ptr)
)
;; else begining of line
;; get next point
(setq 3dll (append 3dll (list (nth (1+ ptr) lep)))
end2 (nth (1+ ptr) lep)
lep (remove_pt ptr (1+ ptr))
)
) ; endif
(setq ptr 0) ; reset pointer
) ; end cond 2
(t
(setq ptr (1+ ptr)) ; inc pointer
)
) ; end cond stmt
) ; end while
;;;=====================================================
;;; Draw 3d poly here using points collected in 3dll
;;;=====================================================
(if 3dll
(progn
(command "_3dpoly")
(foreach pt 3dll
(command pt)
)
(command "")
(setq 3dcnt (1+ 3dcnt))
)
); endif
) ; end while
(command "_erase" sslines "")
(command "_undo" "_end")
(prompt (strcat "\n" (rtos 3dcnt 2 0) " 3dPoly lines created."))
(prompt "\nProcess complete.\n")
(setvar "osmode" useros)
(setvar "CMDECHO" usercmd)
) ; end defun main
(defun remove_pt (first sec / cnt llen newlist)
(setq cnt 0
llen (length lep)
newlist (list)
)
(while (< cnt llen)
(if (and (/= cnt first) (/= cnt sec))
(setq newlist (cons (nth cnt lep) newlist))
)
(setq cnt (1+ cnt))
); end while
(reverse newlist)
); end defun
-
Have a look on the Autodesk Customising ng; same request by Mathew2006 posted02/06, reply by Gile
Hi,
Here is one, only prompts have been translated, comments are still in french.
Even lines, lwpolylines, 2Dpolylines and 3Dpolylines can be joined into a 3Dpolyline. The created 3Dpolyline gets the properties (layer, color, linetype ...) of the first selected object, arcs of lwpolylines aren't conserved.
Not tested!
-
Is the same person asking the same.
-
Is the same person asking the same.
Are you saying that Mathew2006 is Matrix2005in? :-o
Multiple personalities :lol:
-
who is thatttttttt?????????
:x
:police:
-
Try out my
PEDIT3D
from
www.black-cad.de
Good luck!
Jochen