这是一个开始，需要一些清理，但它的工作，它将根据需要创建一个新的pline创建多个形状。但它有时会出错。
发现只是放大一点，它不喜欢缩小时，采摘里面。
斗篷你必须在跑步前引爆！我希望你还有一些问题。
- ; pline co-ords example
- ; By Alan H
- (defun getcoords (ent)
- (vlax-safearray->list
- (vlax-variant-value
- (vlax-get-property
- (vlax-ename->vla-object ent)
- "Coordinates"
- )
- )
- )
- )
- ; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
- (defun co-ords2xy ( / xy)
- (setq len (length co-ords))
- (setq numb (/ len 2)) ; even and odd check required
- (setq I 0)
- (repeat numb
- (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
- (setq co-ordsxy (cons xy co-ordsxy))
- (setq I (+ I 2))
- )
- ) ; co-ords2xy
- ; rule 1 is that start point is always on pline
- ; draw two lines so convex or concave works
- (defun ah:slit (obj obj1 / ent10 ent11 pt1 pt2 pt3 pt4 pt5 pt6 obj2 obj3 intpt1 intpt2)
- (setq ent10 (assoc 10 (entget obj)))
- (setq pt1 (list (cadr ent10)(caddr ent10)))
- (setq ent11 (assoc 11 (entget obj)))
- (setq pt2 (list (cadr ent11)(caddr ent11)))
- (setq ang (angle pt2 pt1))
- (setvar "osmode" 0)
- (setq pt3 (polar pt2 (+ (/ pi 2.0) ang) 0.02))
- (setq pt4 (polar pt2 (- ang (/ pi 2.0) ) 0.02))
- (setq pt5 (polar pt3 ang 1))
- (setq pt6 (polar pt4 ang 1))
- (command "line" pt6 pt4 "")
- (setq obj2 (vlax-ename->vla-object (entlast)))
- (command "line" pt5 pt3 "")
- (setq obj3 (vlax-ename->vla-object (entlast)))
- (setq intpt1 (vlax-invoke obj2 'intersectWith obj1 acExtendnone))
- (setq intpt2 (vlax-invoke obj3 'intersectWith obj1 acExtendnone))
- (command "_break" pickobj intpt1 intpt2)
- ;(command "erase" obj "") ; this is the original line if want to delete
- (vla-delete obj2)
- (vla-delete obj3)
- (command "pline" intpt1 pt4 pt3 intpt2 "")
- (setq obj2 (entlast))
- (command "pedit" pickobj "j" obj2 "" "")
- (princ)
- ) ; defun
- ; starts here
- ; explode shape then premake bpoly
- (defun c:mkslit ( / pt0 pickobj obj1 obj ss co-ordsxy)
- (command "-layer" "m" "poly" "c" 1 "poly" "")
- (setq pt0 (getpoint "pick inside shape"))
- (command "_bpoly" pt0 "")
- (setq pickobj (entlast)) ; pick bpoly this should be done once only
- (setq obj1 (vlax-ename->vla-object pickobj)) ; convert to vl object needed for intersect
- (command "offset" 0.05 pickobj pt0 "")
- (setq co-ords (getcoords (entlast)))
- (princ (co-ords2xy))
- (command "erase" (entlast) "")
- (setq ss (ssget "_CP" co-ordsxy (list (cons 0 "line"))))
- (repeat (setq x (sslength ss))
- (setq obj (ssname ss (setq x (- x 1))))
- (ah:slit obj obj1)
- ) ; repeat
- (princ)
- ) ; mkslit
- (c:mkslit) ; 1st time run on load
| 
置顶卡
