打断与相交的所有线

alanjt · 发表于 2022-7-6 08:32:46

c： BreakwObjects-使用单个对象打断多个对象

kyosmith · 发表于 2022-7-6 08:34:41

我已经见过这个人了。。。
好吧，这不是我需要的。。。

我会告诉大家：

我有一个lisp，可以创建端点带有箭头的直线：

这是代码


(defun C:FLUXO (/ PT ENT PT1 PT2 ANG PTA PTB TP ARANG ARROW Slist OK FIM )
(setq Pt1 (getpoint "\nSpecify first point: ")) 
(initget 1)      
(setq Pt2 (getpoint Pt1 "\nSpecify second point: ")) 
(command "._line" Pt1 Pt2 "")    
(setq old_lay (getvar "clayer"))
(command "layer" "set" "0" "")
(setq setinha  (entlast)
       ARANG (angle PT1 PT2)
FIM     (polar PT2 ARANG -3) ; fim da seta
ARROW (list (cons 0 "LWPOLYLINE")
     (cons 100 "AcDbEntity")
     (cons 8 (getvar "clayer"))
     (cons 100 "AcDbPolyline")
     (cons 90 3)
     (cons 70 128)
     (cons 38 0)
     (cons 39 0)
     (cons 10 PT2)
     (cons 40 0)
     (cons 41 1.5)
     (cons 42 0)
     (cons 10 FIM)
     (cons 40 0)
     (cons 41 0)
     (cons 42 0)
     (cons 40 0)
     (cons 41 0)
     (cons 42 0)
      )
 )
 (entmake ARROW)
 (princ)
(command "layer" "set" old_lay "")
(setq
 SList (ssadd (entlast))    ; begin a selection set of center line
 OK T      ; set flag
) ;_ closes setq
(while OK      ; while still drawing lines
 (setq Pt1 (getvar "LastPoint"))   ; used for next line command
 (setq Pt2 (getpoint Pt1 "\nSpecify next point: ")) ; get next point
 (if Pt2      ; if a point was chosen
  (progn      ; then...
   (command "._line" Pt1 Pt2 "")   ; draw next line
(setq old_lay (getvar "clayer"))
(command "layer" "set" "0" "")
(setq setinha  (entlast)
       ARANG (angle PT1 PT2)
FIM     (polar PT2 ARANG -3) ; fim da seta
ARROW (list (cons 0 "LWPOLYLINE")
     (cons 100 "AcDbEntity")
     (cons 8 (getvar "clayer"))
     (cons 100 "AcDbPolyline")
     (cons 90 3)
     (cons 70 128)
     (cons 38 0)
     (cons 39 0)
     (cons 10 PT2)
     (cons 40 0)
     (cons 41 1.5)
     (cons 42 0)
     (cons 10 FIM)
     (cons 40 0)
     (cons 41 0)
     (cons 42 0)
     (cons 40 0)
     (cons 41 0)
     (cons 42 0)
      )
 )
 (entmake ARROW)
 (princ)
(command "layer" "set" old_lay "")
   (setq SList (ssadd (entlast) SList))
  ) 
  (progn      
   (setq OK NIL)     
  ) 
 ) 
)
)

我的lisp编码很糟糕，所以我修改了另一个person代码。
我需要用箭头画线，然后打断垂直的线，像这样截取水平线：

CAB · 发表于 2022-7-6 08:38:29

使用“BreakWith”将产生以下结果：

fixo · 发表于 2022-7-6 08:42:17

试试我以前的代码库中的Lisp
（不记得它是怎么工作的，抱歉）

BreakVert。lsp

copy


;;break vertical lines only
(defun C:BreakVert(/ copya ent_list hlines hobjs points tmp vlines vobjs)
;;get all lines entity lists
(setq ent_list (mapcar 'entget
 (vl-remove-if 'listp
 (mapcar 'cadr
 (ssnamex (ssget (list '(0 . "LINE"))))))))
;;vertical lines
(setq vlines (mapcar 'cdr
      (mapcar 'car
       (vl-remove-if-not
 (function (lambda(x)
      (equal (car (cdr (assoc 10 x)))
(car (cdr (assoc 11 x))) 0.001))) ent_list))))
;;horizontal lines
(setq hlines (mapcar 'cdr
      (mapcar 'car
       (vl-remove-if-not
 (function (lambda(x)
      (equal (cadr (cdr (assoc 10 x)))
      (cadr (cdr (assoc 11 x))) 0.001))) ent_list))))
;;convert to vla-objects
(setq vobjs (mapcar 'vlax-ename->vla-object vlines))
(setq hobjs (mapcar 'vlax-ename->vla-object hlines))
(foreach a vobjs
 (setq tmp (list (vlax-curve-getstartpoint a)
   (vlax-curve-getendpoint a))
)
 (foreach b hobjs
   (setq points (vlax-invoke a 'Intersectwith b 0))
   (if (= 3 (length points));two perpendicular lines has just one intersection
     (setq tmp (cons points tmp ))))
 (if (> (length tmp) 2)
   (progn
     (setq tmp (vl-sort tmp (function (lambda(x y)
    (< (vlax-curve-getparamatpoint a x)
       (vlax-curve-getparamatpoint a y))))))
     (vla-put-startpoint a (vlax-3d-point (car tmp)))
     (vla-put-endpoint a (vlax-3d-point (cadr tmp)))
     (setq tmp (cdr tmp))
     (repeat (1- (length  tmp))
(setq copya (vla-copy a))
(vla-put-startpoint copya (vlax-3d-point (car tmp)))
(vla-put-endpoint copya (vlax-3d-point (cadr tmp)))
(setq tmp (cdr tmp)))))
 )
 (princ)
 )

BreakHorz。lsp

copy


;;break horizontal lines only
(defun C:BreakHorz(/ copya ent_list hlines hobjs points tmp vlines vobjs)
;;get all lines entity lists
(setq ent_list (mapcar 'entget
 (vl-remove-if 'listp
 (mapcar 'cadr
 (ssnamex (ssget (list '(0 . "LINE"))))))))
;;vertical lines
(setq vlines (mapcar 'cdr
      (mapcar 'car
       (vl-remove-if-not
 (function (lambda(x)
      (equal (car (cdr (assoc 10 x)))
(car (cdr (assoc 11 x))) 0.001))) ent_list))))
;;horizontal lines
(setq hlines (mapcar 'cdr
      (mapcar 'car
       (vl-remove-if-not
 (function (lambda(x)
      (equal (cadr (cdr (assoc 10 x)))
      (cadr (cdr (assoc 11 x))) 0.001))) ent_list))))
;;convert to vla-objects
(setq vobjs (mapcar 'vlax-ename->vla-object vlines))
(setq hobjs (mapcar 'vlax-ename->vla-object hlines))
(foreach a hobjs
 (setq tmp (list (vlax-curve-getstartpoint a)
   (vlax-curve-getendpoint a))
)
 (foreach b vobjs
   (setq points (vlax-invoke a 'Intersectwith b 0))
   (if (= 3 (length points));two perpendicular lines has just one intersection
     (setq tmp (cons points tmp ))))
 (if (> (length tmp) 2)
   (progn
     (setq tmp (vl-sort tmp (function (lambda(x y)
    (< (vlax-curve-getparamatpoint a x)
       (vlax-curve-getparamatpoint a y))))))
     (vla-put-startpoint a (vlax-3d-point (car tmp)))
     (vla-put-endpoint a (vlax-3d-point (cadr tmp)))
     (setq tmp (cdr tmp))
     (repeat (1- (length  tmp))
(setq copya (vla-copy a))
(vla-put-startpoint copya (vlax-3d-point (car tmp)))
(vla-put-endpoint copya (vlax-3d-point (cadr tmp)))
(setq tmp (cdr tmp)))))
 )
 (princ)
 )

~'J'~

kyosmith · 发表于 2022-7-6 08:45:34

fixo如何在垂直代码中设置偏移距离？

kyosmith · 发表于 2022-7-6 08:47:53

驾驶室：我需要垂直卡扣完好无损。“BreakWith”将其打断为

修正：
我在代码中添加了这一行

copy

(setq pt1 (polar (car tmp) 1.57079633  -2))
(setq pt2 (polar (cadr tmp) 4.71238898 -2))
(vla-put-startpoint copya (vlax-3d-point pt1))
(vla-put-endpoint copya (vlax-3d-point pt2))

但它也破坏了垂直捕捉