ktbjx 发表于 2022-7-5 16:36:22

复制最近的高程

是否有lisp例程使其更容易?因为我是手工做的,太耗时了。。
 
有没有办法复制最近多段线的高程,并使其成为其他对象的高程,而不包含其高程或Z???
图纸2.dwg

ktbjx 发表于 2022-7-5 17:03:38

我做了一个!嗯,至少我可以更快地工作。。。
如果有人能做得更好,我真的很乐意接受建议
 
(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)
)

Lee Mac 发表于 2022-7-5 17:09:56

考虑以下因素:
(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)

ktbjx 发表于 2022-7-5 17:30:04

 
 
 
命令:fixelevation
 
选择具有高程的多段线:
选择要修改的多段线:;错误:没有函数定义:
VLAX-CURVE-GETCLOSESTPOINTTO
 
 
有一个错误,先生,我想更改的不是突出的多段线,而是文字(位置Z)、引线(顶点Z)、直线(星形/端点Z)。。。

Lee Mac 发表于 2022-7-5 17:46:30

请尝试上面更新的代码。
页: [1]
查看完整版本: 复制最近的高程