[求助] 江湖救急!!!

429014673

我想把多個聚合線一次相加是沒有相連的聚合線不想點一次加一次太多線段沒相連要加一起太麻煩了有沒有快一點的方法??急…謝謝!!!

429014673

这个就是原程序，但要一个一个地选，担误了太多时间，希望哪们仁兄，帮忙下

 

(DEFUN C:WW(/ LINE1 LINE2 PT1 PT2 PT3 PT4 PT5 PTLIST OLDERR VAR1 VAR2 RDRAWENT)
  (DEFUN ERRORCP() (PRINC))
  (DEFUN MAXDISTANCE (PT1 PT2 PT3 PT4 / L12 L13 L14 L23 L24 L34 L PTLIST)
    (SETQ L12 (DISTANCE PT1 PT2)
          L13 (DISTANCE PT1 PT3)
          L14 (DISTANCE PT1 PT4)
          L23 (DISTANCE PT2 PT3)
          L24 (DISTANCE PT2 PT4)
          L34 (DISTANCE PT2 PT4)
     )
    (SETQ L (MAX L12 L13 L14 L23 L24 L34))
    (COND ((= L L12) (SETQ PTLIST (LIST PT1 PT2)) )
          ((= L L13) (SETQ PTLIST (LIST PT1 PT3)) )
          ((= L L14) (SETQ PTLIST (LIST PT1 PT4)) )
          ((= L L23) (SETQ PTLIST (LIST PT2 PT3)) )
          ((= L L24) (SETQ PTLIST (LIST PT2 PT4)) )
          ((= L L34) (SETQ PTLIST (LIST PT3 PT4)) )
    )
   (SETQ PTLIST PTLIST)
  )

  (SETQ OLDERR *ERROR* *ERROR* ERRORCP)
  (PRINC "\n 牵线 !\(VER 0.2版 1999/5/31\)" )
  (SETQ LINE1 (ENTGET (CAR (ENTSEL "\n请选择一条直线"))))
  (SETQ RDRAWENT (CDR (ASSOC -1 LINE1)))
  (REDRAW RDRAWENT 3)
  (SETQ LINE2 (ENTGET (CAR (ENTSEL "\n请选择另一直线")))
  )
  (IF (EQUAL LINE1 LINE2)       
     (PROGN (PRINC "\n你所选择的是同一条直线!!!") (REDRAW RDRAWENT 4) (EXIT)) )
  (IF (OR (/= (CDR (ASSOC 0 LINE1)) "LINE")
          (/= (CDR (ASSOC 0 LINE2)) "LINE"))
     (PROGN (PRINC "\n你选择的实体不是直线!!!") (REDRAW RDRAWENT 4) (EXIT))
  )
  (SETQ PT1 (CDR (ASSOC 10 LINE1))
        PT2 (CDR (ASSOC 11 LINE1))
        PT3 (CDR (ASSOC 10 LINE2))
        PT4 (CDR (ASSOC 11 LINE2))
  )
  (SETQ PT5 (INTERS PT1 PT2 PT3 PT4 NIL))
  (IF (/= NIL PT5) (PROGN (PRINC "\n两直线不共线!!!") (REDRAW RDRAWENT 4) (EXIT)))
  (SETQ PT5 (POLAR PT1 (+ (/ PI 2) (ANGLE PT1 PT2)) 1 ) )
  (SETQ PT5 (INTERS PT3 PT4 PT1 PT5 NIL))(PRINC PT1)(PRINC "   ")(PRINC PT5)

(SETQ VAR1 (EQUAL (CAR PT1) (CAR PT5) 0.00000001) VAR2 (EQUAL (CADR PT1) (CADR PT5) 0.00000001))
;  (SETQ VAR1 (= (ATOF (RTOS (CAR PT1) 2 8)) (ATOF (RTOS (CAR PT5) 2 8)) ) ) ;3/13 VERSION 0.1
;  (SETQ VAR2 (= (ATOF (RTOS (CADR PT1) 2 8)) (ATOF (RTOS (CADR PT5) 2 8 )) ) )

  (IF (AND VAR1 VAR2) (PRINC "OK")
       (PROGN (PRINC "\n 两直线平行!!!") (REDRAW RDRAWENT 4) (EXIT)))
  (SETQ PTLIST (MAXDISTANCE PT1 PT2 PT3 PT4))
  (SETQ LINE1 (SUBST (CONS 10 (CAR PTLIST)) (ASSOC 10 LINE1) LINE1))
  (SETQ LINE1 (SUBST (CONS 11 (CADR PTLIST)) (ASSOC 11 LINE1) LINE1))
  (ENTMOD LINE1)
  (ENTDEL (CDR (ASSOC -1 LINE2)) )
  (SETQ *ERROR* OLDERR)
  (PRINC "\nOK!")
  (PRINC)
)

429014673

<img src="http://b41.photo.store.qq.com/http_imgload.cgi?/rurl4_b=b860fb02d8353bce28ab52374b4d54cbddd604dbb9f07a2dbb691399f9a74e8f9560bc54ed03259998c9eda7f4b185296895aa3ee4cb314c1a3327a091f8cf01a916c342387543592c568207726c78583a55b601&amp;a=46&amp;b=41"/>

AMTONNY

来个简单的，在空间里下载的哦

(defun cEN( / i len n ss)
 (setq ss (ssget) i -1 len 0)
 (repeat (sslength ss)
  (setq n (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
  (setq len (+ len (vlax-curve-getDistAtParam n (vlax-curve-getEndParam n))))
 )
 ;len
)