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

spp_wall

现在需要一个 个的点直线来标注！
(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_ent1  p11 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

2. 
   
3. (defun c:tt (/ i ss s1 ptn)
   
4.   (xyp-CMDLA0)
   
5.   (setq i -1)
   
6.   (if (setq ss (ssget '((0 . "*LINE"))))
   
7.     (while (setq s1 (ssname ss (setq i (1+ i))))
   
8.       (setq ptn (xyp-Get-CurveIntersLeng s1 3))
   
9.       (xyp-Dim-AliBatch ptn 1000)
   
10.     )
    
11.   )
    
12.   (xyp-CMDLA1)
    
13. )
    

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

spp_wall

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

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

qq277274448

谢谢，我正找这个。。。。