连接三维多段线
大家好可以通过lisp连接三维多段线
谢谢 不是百分之百确定，但看看这个名为PEDIT3D的lisp例程。
href=”http://www.black-cad.de">http://www.black-cad.de 也许是上师李给出的答案！
http://lee-mac.com/polylineprograms.html 这是一个非常古老的1：
;=======================================================================
; JPline.Lsp May 30, 2007
; Joins Any 2 ECS LINEs, ARCs, Or POLYLINEs That Have A
; Common End Point Into New WCS 3DPOLY
;================== Start Program ======================================
(princ "\nCopyright (C) 2007, Fabricated Designs, Inc.")
(princ "\nLoading JPline v1.5 ")
;;;1.5 LWPolyLines & zerop Thickness
(setq jp_ nil lsp_file "JPline")
;==== For Automated Calling From Another Program =======================
(defun jp_auto (ar1 ar2) ;;;Provide enames Of
(jp_make ar1 ar2)) ;;;2 Entities To Join
;================== Macros =============================================
(defun PDot ()(princ "."))
(defun Beep (/ f)
(and (wcmatch (getvar "PLATFORM") "*DOS*")
(setq f (open "con" "w"))
(write-char '7 f)
(close f)))
(defun Err (e)
(beep)
(princ (strcat "\nError: ** " e " ** "))
(quit))
(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun jp_smd ()
(SetUndo)
(setq oldlay (getvar "CLAYER")
olderr *error*
*error* (lambda (e)
(while (> (getvar "CMDACTIVE") 0)
(command))
(and (/= e "quit / exit abort")
(princ (strcat "\nError: *** " e " *** ")))
(command "_.UNDO" "_END" "_.U")
(jp_rmd))
jp_var '(
("CMDECHO" . 0) ("MENUECHO" . 0)
("MENUCTL" . 0) ("MACROTRACE" . 0)
("OSMODE" . 0) ("SORTENTS" . 119)
("REGENMODE" . 1) ("MODEMACRO" . ".")
("BLIPMODE". 0) ("EXPERT" . 0)
("SNAPMODE". 1) ("PLINEWID" . 0.0)
("ORTHOMODE" . 1) ("GRIDMODE" . 0)
("ELEVATION" . 0) ("THICKNESS". 0)
("UCSICON" . 0) ("HIGHLIGHT" . 1)
("COORDS" . 2) ("DRAGMODE" . 2)
("CECOLOR" . "BYLAYER") ("CELTYPE" . "BYLAYER")))
(foreach v jp_var
(setq m_v (cons (getvar (car v)) m_v)
m_n (cons (car v) m_n))
(setvar (car v) (cdr v)))
(if (not (entnext))
(err "There Are No Entities To Work With!"))
(princ (strcat (getvar "PLATFORM") " Release " (substr (ver) 18 2)
" -Join LINES, ARCS, & PLINES ....\n"))
(princ))
(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun jp_rmd ()
(SetLayer oldlay)
(setq *error* olderr)
(mapcar 'setvar m_n m_v)
(command "_.UNDO" "_END")
(prin1))
(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
(command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
(command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))
(PDot);++++++++++++ Make Layer Current +++++++++++++++++++++++++++++++++
(defun SetLayer (lay_name / lay_list lay_flag)
(if (not (tblsearch "LAYER" lay_name))
(command "_.LAYER" "_MAKE" lay_name "")
(progn
(setq lay_list (tblsearch "LAYER" lay_name)
lay_flag (cdr (assoc 70 lay_list)))
(if (= (logand lay_flag1)1)
(command "_.LAYER" "_THAW" lay_name ""))
(if (minusp (cdr (assoc 62 lay_list)))
(command "_.LAYER" "_ON" lay_name ""))
(if (= (logand lay_flag4)4)
(command "_.LAYER" "_UNLOCK" lay_name ""))
(and (= (logand lay_flag 16) 16)
(princ "\nCannot Set To XRef Dependent Layer")
(quit))
(command "_.LAYER" "_SET" lay_name ""))))
(PDot);++++++++++++ Convert LINE To 3DPOLY +++++++++++++++++++++++++++++
(defun ledit (ln / ld lay pt1 pt2 lty thk clr hf vf)
(and (= (type ln) 'ENAME)
(setq ld (entget ln))
(= (cdr (assoc 0 ld)) "LINE")
(setq lay (cdr (assoc8 ld))
pt1 (cdr (assoc 10 ld))
pt2 (cdr (assoc 11 ld))
lty (if (assoc6 ld) (cdr (assoc6 ld)) "BYLAYER")
thk (if (assoc 39 ld) (cdr (assoc 39 ld)) 0.0)
clr (if (assoc 62 ld) (cdr (assoc 62 ld)) 256)))
(if (and pt1 pt2)
(progn
(if (equal (caddr pt1) (caddr pt2) 0.0001)
(setq hf 0 vf 0)
(setq hf 8 vf 32 thk 0.0 lty "BYLAYER"))
(entdel ln)
(entmake (list (cons 0 "POLYLINE")(cons 8 lay)(cons 66 1)
(cons 10 (list 0.0 0.0 0.0))(cons 70 hf)
(cons 40 0.0)(cons 41 0.0)(cons 210 (list 0.0 0.0 1.0))
(cons 71 0)(cons 72 0)(cons 73 0)(cons 74 0)(cons 75 0)
(cons 62 clr)(cons 39 thk)(cons 6 lty)))
(entmake (list (cons 0 "VERTEX")(cons 8 lay)(cons 10 pt1)
(cons 40 0.0)(cons 41 0.0)(cons 42 0.0)
(cons 70 vf)(cons 50 0.0)
(cons 71 0)(cons 72 0)(cons 73 0)(cons 74 0)
(cons 62 clr)(cons 39 thk)(cons 6 lty)))
(entmake (list (cons 0 "VERTEX")(cons 8 lay)(cons 10 pt2)
(cons 40 0.0)(cons 41 0.0)(cons 42 0.0)
(cons 70 vf)(cons 50 0.0)
(cons 71 0)(cons 72 0)(cons 73 0)(cons 74 0)
(cons 62 clr)(cons 39 thk)(cons 6 lty)))
(entmake (list (cons 0 "SEQEND")(cons 8 lay))))
(progn
(princ "\n*LEDIT* Unsuccessful ")
(exit))))
(PDot);++++++++++++ Get Entity Name ++++++++++++++++++++++++++++++++++++
(defun GetOne (/ st os)
(setq os (getvar "SNAPMODE") s nil)
(setvar "SNAPMODE" 0)
(while (not st)
(setq st (ssget)))
(while (> (sslength st) 1)
(setq st nil)
(princ "\nOnly 1 At A Time Please\n")
(while (not st)
(setq st (ssget))))
(setvar "SNAPMODE" os)
(setq s (ssname st 0)))
;++++++++++++ FINDPATH +++++++++++++++++++++++++++++++++++++++++++
;;;Returns ECS Point Values Of PLINE
(defun findpath (en / pl ed sp_flg cl_flg bf nl i vp bf vf pl_flg)
(setq ed (entget en))
(and (/= "POLYLINE" (cdr (assoc 0 ed)))
(princ "\nUnable To Find The Path For This Entity ")
(exit))
(setq pl_flg (cdr (assoc 70 ed)))
(and (= (logand pl_flg 1) 1)
(setq cl_flg T))
(and (= (logand pl_flg 4) 4)
(setq sp_flg T))
(and (or (= (logand pl_flg 16) 16)
(= (logand pl_flg 64) 64))
(princ "\nInvalid POLYLINE Mesh ")
(exit))
(while (/= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
(setq en (entnext en)
ed (entget en)
vp (cdr (assoc 10 ed))
bf (cdr (assoc 42 ed))
vf (cdr (assoc 70 ed)))
(cond ((= "SEQEND" (cdr (assoc 0 (entget (entnext en)))))
(setq pl (cons vp pl)))
((and (/= bf 0.0)
(/= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
(add_arc vp (cdr (assoc 10 (entget (entnext en)))) bf))
((and (/= bf 0.0)
cl_flg
(= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
(add_arc vp (last pl) bf))
((and (= bf 1.0)
(not cl_flg)
(= "SEQEND" (cdr (assoc 0 (entget (entnext en))))))
(princ))
((and sp_flg
(= bf 0.0)
(= (logand vf8))
(setq pl (cons vp pl)))
((and (not sp_flg)
(= bf 0.0)
(/= (logand vf8))
(setq pl (cons vp pl)))))
(if (and cl_flg
(not (equal (car pl) (last pl))))
(setq pl (cons (last pl) pl)))
(setq i 0)
(while (< i (length pl))
(while (equal (nth i pl) (nth (1+ i) pl) 0.0001)
(setq i (1+ i)))
(and (nth i pl)
(setq nl (cons (nth i pl) nl)))
(setq i (1+ i)))
nl)
(defun add_arc (sp ep bulge / alist x1 x2 y1 y2 cotbce
ce ra sa ea ia inc qty na temp rseg)
(setq x1 (car sp);;Modified Bulge
x2 (car ep);;Conversion By
y1 (cadr sp);;Duff Kurland
y2 (cadr ep);;Autodesk, Inc.
cotbce (/ (- (/ 1.0 bulge) bulge) 2.0)
ce (list (/ (+ x1 x2 (- (* (- y2 y1) cotbce))) 2.0)
(/ (+ y1 y2 (* (- x2 x1) cotbce) ) 2.0)
(caddr sp))
ra (distance ce sp)
sa (atan (- y1 (cadr ce)) (- x1 (car ce)))
ea (atan (- y2 (cadr ce)) (- x2 (car ce))))
(if (minusp sa)
(setq sa (+ sa (* 2.0 pi))))
(if (minusp ea)
(setq ea (+ ea (* 2.0 pi))))
(if (minusp bulge)
(setq temp sa sa ea ea temp))
(if (> sa ea)
(setq ia (+ (- (* pi 2.0) sa) ea))
(setq ia (- ea sa)))
(if (not rseg)
(progn
(initget 6)
(setq rseg (getint "\nNumber Of Segments To A 180 Degree Arc <16>: "))
(and (not rseg)
(setq rseg 16))))
(setq qty (abs (fix (/ ia (/ pi rseg)))))
(if (< qty 2)
(setq qty 2))
(setq na sa
inc (/ (abs ia) qty))
(repeat (1+ qty)
(setq alist (cons (polar ce na ra) alist)
na (+ sa inc)
sa na))
(if (not (equal sp (car alist) 0.0001))
(setq alist (reverse alist)))
(foreach a alist
(setq pl (cons a pl))))
(PDot);++++++++++++ Make 3DPOLY From 2 PLINES ++++++++++++++++++++++++
(defun jp_make (p1 p2)
(command "_.UCS" "_World")
(if (= (cdr (assoc 0 (entget p1))) "LINE")
(progn
(ledit p1)
(setq p1 (entlast))))
(if (= (cdr (assoc 0 (entget p1))) "ARC")
(progn
(if (not (equal (cdr (assoc 210 (entget p1))) 0.00001))
(command "_.UCS" "_E" p1))
(command "_.PEDIT" p1 "_Yes" "_Exit")
(setq p1 (entlast))))
(command "_.UCS" "_World")
(if (= (cdr (assoc 0 (entget p2))) "LINE")
(progn
(ledit p2)
(setq p2 (entlast))))
(if (= (cdr (assoc 0 (entget p2))) "ARC")
(progn
(if (not (equal (cdr (assoc 210 (entget p2))) 0.00001))
(command "_.UCS" "_E" p2))
(command "_.PEDIT" p2 "_Yes" "_Exit")
(setq p2 (entlast))))
(command "_.UCS" "_World")
(setq l1 (findpath p1))
(setq l2 (findpath p2))
(foreach v l1 (setq w1 (cons (trans v p1 0) w1)))
(foreach v l2 (setq w2 (cons (trans v p2 0) w2)))
(cond ((equal (last w1) (car w2) 0.0001) (princ))
((equal (last w2) (car w1) 0.0001) (setq w1 (reverse w1)
w2 (reverse w2)))
((equal (last w1) (last w2) 0.0001) (setq w2 (reverse w2)))
((equal (car w1) (car w2) 0.0001) (setq w1 (reverse w1)))
(t(err "Entities Do Not Have Common End Points")))
(setq w2 (cdr w2))
(command "_.3DPOLY")
(foreach p w1
(command p))
(foreach p w2
(command p))
(command "")
(entdel p1)
(entdel p2)
(redraw (entlast)))
(PDot);++++++++++++ Compare 2 PLINEs +++++++++++++++++++++++++++++++++++
(defun jp_comp (/ df1 df2 et1 et2 lt1 lt2 la1 la2 tk1 tk2 cl1 cl2
wd1 wd2 wd3 wd4 lter tker laer cler wder)
(if (equal e1 e2)
(err "Cannot Join Same Entity"))
(setq df1 (entget e1)
df2 (entget e2)
et1 (cdr (assoc 0 df1))
et2 (cdr (assoc 0 df2))
lt1 (cdr (assoc 6 df1))
lt2 (cdr (assoc 6 df2))
la1 (cdr (assoc 8 df1))
la2 (cdr (assoc 8 df2))
tk1 (cdr (assoc 39 df1))
tk2 (cdr (assoc 39 df2))
wd1 (cdr (assoc 40 df1))
wd2 (cdr (assoc 40 df2))
wd3 (cdr (assoc 41 df1))
wd4 (cdr (assoc 41 df2))
cl1 (cdr (assoc 62 df1))
cl2 (cdr (assoc 62 df2)))
(and (or lt1 lt2)
(setq lter t))
(and (/= la1 la2)
(setq laer t))
(and (or tk1 tk2)
(not (zerop tk1))
(not (zerop tk2))
(setq tker t))
(and (/= cl1 cl2)
(setq cler t))
(if (and (= et1 "POLYLINE")
(= et2 "POLYLINE")
(or (/= wd1 0.0)
(/= wd2 0.0)
(/= wd3 0.0)
(/= wd4 0.0)))
(setq wder t))
(if (or lter tker wder)
(progn
(beep)
(princ "\nEntities Contain ")
(if wder (princ "WIDTHS"))
(and wder (and lter tker)
(princ ", "))
(and wder lter (not tker)
(princ " & "))
(and wder tker (not lter)
(princ " & "))
(if lter (princ "LINETYPES"))
(and lter tker
(princ " & "))
(if tker (princ "THICKNESS"))
(princ " That Can Not Be Duplicated")
(initget "Yes No")
(if (= "No" (getkword "\nContinue:<Y>: "))
(exit))))
(if laer
(progn
(beep)
(princ "\nEntities Reside On Different Layers")
(princ "\nNew 3DPOLY Will Be Constructed On LAyer ")
(prin1 (getvar "CLAYER"))
(getstring " Press Any Key To Continue:")))
(if (and (not laer)
(/= (getvar "CLAYER") la1))
(SetLayer la1))
(if cler
(progn
(beep)
(princ "\nEntities Have Different Colors")
(princ "\nNew 3DPOLY Will Be Constructed With Color \"BYLAYER\"")
(getstring " Press Any Key To Continue:")))
(if (and cl1
(not cler)
(not (zerop cl1)))
(setvar "CECOLOR" (itoa cl1))))
(PDot);************ Main Program ***************************************
(defun jp_ (/ m_v m_n olderr oldlay jp_var e1 e2 l1 l2 w1 w2 s)
(jp_smd)
(princ "\nSelect 1st LINE, ARC, or PLINE:")
(setq e1 (GetOne))
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget e1))))
(command "_.CONVERTPOLY" "Heavy" e1 ""))
(princ "\nSelect 2nd LINE, ARC, or PLINE:")
(setq e2 (GetOne))
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget e2))))
(command "_.CONVERTPOLY" "Heavy" e2 ""))
(jp_comp)
(jp_make e1 e2)
(jp_rmd))
(PDot);************ Load Program ***************************************
(defun C:JPline () (jp_))
(if jp_ (princ "\nJPline Loaded\n"))
(prin1)
;================== End Program ========================================
;Tested With R12_c3 DOS & R13_c4a DOS
;Copyright (C) 2007, Fabricated Designs, Inc.
;"AS IS" Public Domain Software Donated By
-大卫
我已经多次使用这个lisp例程。
对我来说效果很好。 链接不工作
我点击了这个帖子中的所有链接，它们工作正常。
你在尝试哪个链接？
很难反驳这种逻辑，因为它通常是这样的！
似乎到Pedit3D lisp的链接不起作用。
我确实有一份lisp的副本，其中有一条声明：“未经作者同意，禁止以任何形式复制、修改和分发本软件或其任何部分，除非本文明确规定。”
在网站链接页面上有一条声明“这是免费下载的版本”
也许版主可以声明我是否可以上传到这里。
或者MOTE-z，也许你可以给作者发电子邮件，电子邮件地址在链接页面上。 很抱歉输入了错别字
http://www.black-cad.de
希望我得到它。。。
它现在也适用于螺旋曲线。
祝你好运
约琴
页:
[1]
2