复制最近的高程
是否有lisp例程使其更容易?因为我是手工做的,太耗时了。。有没有办法复制最近多段线的高程,并使其成为其他对象的高程,而不包含其高程或Z???
图纸2.dwg 我做了一个!嗯,至少我可以更快地工作。。。
如果有人能做得更好,我真的很乐意接受建议
(vl-load-com)
(defun c:qq (/ elevations sss)
(if (ssget '((0 . "*POLYLINE")))
(progn
(vlax-for x (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(setq elevations (cons (vla-get-elevation x) elevations))
)
(prompt "\n2nd Selection")
(setq sss (ssget "_:L"))
(command"_.CHANGE" sss "" "_P" "_E" (rtos (last elevations))
)
)
)
(princ)
) 考虑以下因素:
(defun c:fixelevation ( / dis dst elv ent enx idx lst src tmp vts )
(if (and (setq src (LM:ssget "\nSelect polylines with elevation: " '(((0 . "LWPOLYLINE")))))
(setq dst (LM:ssget "\nSelect polylines to modify: " '("_:L" ((0 . "LWPOLYLINE")))))
)
(progn
(repeat (setq idx (sslength src))
(setq ent (ssname src (setq idx (1- idx)))
lst (cons (cons ent (assoc 38 (entget ent))) lst)
)
)
(repeat (setq idx (sslength dst))
(setq enx (entget (ssname dst (setq idx (1- idx))))
vts (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx))
dis (getmindistance (caar lst) vts)
elv (cdar lst)
)
(foreach itm (cdr lst)
(if (< (setq tmp (getmindistance (car itm) vts)) dis)
(setq elv (cdr itm)
dis tmp
)
)
)
(entmod (subst elv (assoc 38 enx) enx))
)
)
)
(princ)
)
(defun getmindistance ( ent lst / dis tmp )
(setq dis 1e308)
(foreach vtx lst
(if (< (setq tmp (distance vtx (vlax-curve-getclosestpointto ent vtx))) dis)
(setq dis tmp)
)
)
dis
)
;; ssget-Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)
命令:fixelevation
选择具有高程的多段线:
选择要修改的多段线:;错误:没有函数定义:
VLAX-CURVE-GETCLOSESTPOINTTO
有一个错误,先生,我想更改的不是突出的多段线,而是文字(位置Z)、引线(顶点Z)、直线(星形/端点Z)。。。 请尝试上面更新的代码。
页:
[1]