spp_wall 发表于 2013-10-13 21:26:57

求高手能否修改下 实现批量标注两条直线的交点宽度！

现在需要一个 个的点直线来标注！
(defun c:jdbz2 ()
(vl-load-com)
(defun GETINTERS
         (FSTENT NXTENT XMODE / INTPNT PNTLST TMPLST TMPPNT)
    (cond
      ((and FSTENT NXTENT)
       (setq INTPNT (vla-intersectwith
                      (vlax-ename->vla-object FSTENT)
                      (vlax-ename->vla-object NXTENT)
                      XMODE
                      )
             TMPPNT (vlax-variant-value INTPNT)
             )
       (cond
         ((safearray-value TMPPNT)
          (setq TMPLST (vlax-safearray->list TMPPNT))
          (repeat (/ (length TMPLST) 3)
            (setq PNTLST
                         (cons
                           (list
                           (car TMPLST)
                           (cadr TMPLST)
                           (caddr TMPLST)
                           )
                           PNTLST
                           )
                  TMPLST (cdddr TMPLST)
                  )
            )
          (reverse PNTLST)
          )
         (t NIL)
         )
       )
      (t NIL)
      )
    )
(princ "选择辅助线\n")
(setq m_ent1 (car (entsel)))
(print "请选择需要扫描的区域：")
(setq ss (ssget) ss1 (ssadd))
(setq lengss (sslength ss))
(setq bb 0)
(while (< bb lengss)
    (setq p1 (ssname ss bb))
    (setq ed (entget p1))
    (setq m_jdtab14 (vla-intersectwith
                      (vlax-ename->vla-object p1)
                      (vlax-ename->vla-object m_ent1)
                      0
                  )
    )
    (setq pts1 (vlax-variant-value m_jdtab14))
    (if      (> (vlax-safearray-get-u-bound pts1 1) 0)
      (ssadd p1 ss1)
    )
    (setq bb (+ bb 1))
)
(setq lengss (sslength ss1))
(setq bb 0 pts '())
(while (< bb lengss)
    (setq p11 (ssname ss1 bb))
    (setq p14 (getinters m_ent1p11 0))
    ;(setq p14 (vlax-safearray->list (vlax-variant-value m_jdtab14)))
    (setq pts (append p14 pts))
    (command "circle" p14 50 )
    (setq bb (+ bb 1))
)
;(setq pt0 (vlax-curve-getStartPoint (vlax-ename->vla-object m_ent1)))
(setq pts (vl-sort pts '(lambda (s1 s2) (< (vlax-curve-getDistAtPoint (vlax-ename->vla-object m_ent1) s1)
                  (vlax-curve-getDistAtPoint (vlax-ename->vla-object m_ent1) s2)))
                  ))
(setq bb 0)
(repeat (1- (length pts)) (command "_dimaligned" (nth bb pts) (nth (1+ bb) pts) (nth (1+ bb) pts))
    (setq bb (+ bb 1))
    )
)

xyp1964 发表于 2013-10-13 22:11:55


(defun c:tt (/ i ss s1 ptn)
(xyp-CMDLA0)
(setq i -1)
(if (setq ss (ssget '((0 . "*LINE"))))
    (while (setq s1 (ssname ss (setq i (1+ i))))
      (setq ptn (xyp-Get-CurveIntersLeng s1 3))
      (xyp-Dim-AliBatch ptn 1000)
    )
)
(xyp-CMDLA1)
)

spp_wall 发表于 2013-10-14 08:29:16

xyp1964 发表于 2013-10-13 22:11 static/image/common/back.gif


谢谢院长！！！！！！！！！

qq277274448 发表于 2014-9-26 00:23:20

谢谢，我正找这个。。。。
页: [1]
查看完整版本: 求高手能否修改下 实现批量标注两条直线的交点宽度！