树櫴希德 发表于 2015-9-1 09:01:37

多段线批量注记坐标

多段线批量注记坐标,73哥函数(defun C:ddxzb(/ cd cd1 cd2 x y zh zj x y zj1 k ss ent11)
   (command "LAYER" "M" "htext" "")
   (princ "\n比例尺:<")
   (princ scale)
   (princ ">")
   (setq scale1 (getreal))
   (if (not (null scale1)) (setq scale scale1))
   (setq zh (/ (* 2.5 scale) 1000)
         zj (* zh 4)
         zj (list zj zj)
   )

;标注坐标函数
(defun rrdd (cd zh zj / x y sset1 sset2 sset3)
      (setvar "luprec" 3)
      (command "OSNAP" "")
      (setq x (strcat "Y=" (rtos (car cd)))
            y (strcat "X=" (rtos (cadr cd)))
            ;cd (mapcar '+ cd zj)
      )
   (setq zj1 (* zh 0.3))
(command "LINE" cd
               (mapcar '- cd (list 0 zj1))
               ""
      )
      (command "TEXT" cd zh 0 y)
      (setq sset1 (ssget "l"))
      (setq zj1 (* zh 1.5)
            cd (mapcar '- cd (list 0 zj1))
      )
      (command "TEXT" cd "" 0 x)
      (setq sset2 (ssget "l"))
      (setq zj1 (* zh 1.2)
            cd (mapcar '+ cd (list 0 zj1))
      )
      (command "LINE" cd
               (polar cd 0 (/ (* 25 scale) 1000))
               ""
      )
      (setq sset3 (ssget "l"))
      (command "select" sset1 sset2 sset3 "")
      (setq sset (ssget "p"))
)

(defun Plinexy(e / p a b n ob q et d d1 en et) ;;多线段节点坐标(滤掉了多余点,未处理假闭合)
   (setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
   (cond((="LWPOLYLINE"et)
         (repeat(length a)(setq b (nth n a) n (+ n 1))
         (if (= 10 (car b))(progn
                               (setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
                               (if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
                                 (setq p (list q))))
             )))
      ((="POLYLINE"et)
         (SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
         (WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
         (SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
         (if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
             (setq p (list q)))
         (SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
         (setq p(reverse p))
         ))
   P)
;;;;
(setq ss (ssget '((0 . "lwpolyline,polyline"))) )
(repeat (setq k (sslength ss))
    (setq ent11 (ssname ss (setq k (1- k))))

;(setq ent11(car (entsel"\n请选择多段线:")))

(foreach cd (plinexy ent11)
    (rrdd cd zh zj)


)
)










)

spp_wall 发表于 2015-9-1 11:13:14

XY 叠在一起?

luojie110 发表于 2017-11-17 17:28:43

; 错误: no function definition: VLAX-ENAME->VLA-OBJECT
这是什么原因呢?
页: [1]
查看完整版本: 多段线批量注记坐标