有么有CAD中多边形内批量指定面积大小分割面积的插件？
有么有CAD中多边形内批量指定面积大小分割面积的插件？有需要可QQ联系736188807
插件下载http://xlrtool.ys168.com/
太多了，在LISP论坛有很多，，，
xiabin68 发表于 2017-10-6 13:22
太多了，在LISP论坛有很多，，，
没找到啊，都是收费的，只是用一段时间，不是专门搞地籍的，就是找不到免费的，好用的 2019835052 发表于 2017-10-7 21:46
没找到啊，都是收费的，只是用一段时间，不是专门搞地籍的，就是找不到免费的，好用的
就给点钱吧，不贵最多不超过300元，， (vl-load-com)
(defun ebox (e / pa pb)
(Vlax-Invoke-Method (Vlax-Ename->Vla-Object e ) 'GetBoundingBox 'pa 'pb )
(setq pa (trans (vlax-safearray->list pa) 0 1)
pb (trans (vlax-safearray->list pb) 0 1)
)
(list pa pb)
)
(defun cbox (e / box)
(setq box (ebox e))
(mid (car box) (cadr box))
)
(defun mid (p1 p2) (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2)))
(defun mktext (str pt th)
(entmake (list '(0 . "TEXT")
(cons 1 str)
(cons 10 pt)
(cons 40 th)
(cons 11 pt)
(cons 71 0)
(cons 72 1)
(cons 73 2)
)
)
)
(defun str2lst ( str del / pos )
(if (setq pos (vl-string-search del str))
(cons (substr str 1 pos) (str2lst (substr str (+ pos 1 (strlen del))) del))
(list str)
)
)
(defun ptscen (Pts / )
(MAT:vxs (apply 'mapcar (cons '+ pts)) (/ 1.0 (length pts)))
)
(defun MAT:vxs ( v s )
(mapcar (function (lambda ( n ) (* n s))) v)
)
(defun dxf (key ename) (cdr (assoc key (entget ename))))
(defun 2epi ( e1 e2 mode / l r )
(setq obj1 (vlax-ename->vla-object e1)
obj2 (vlax-ename->vla-object e2)
l (vlax-invoke obj1 'intersectwith obj2 mode))
(repeat (/ (length l) 3)
(setq r (cons (list (car l) (cadr l) (caddr l)) r)
l (cdddr l)
)
)
(reverse r)
)
(defun p2ld (pt p1 p2 / )
(car (trans (mapcar '- pt p1) 0 (mapcar '- p2 p1)))
)
(defun gvp (e)
(vl-remove nil (mapcar '(lambda (x) (if (= (car x) 10) (trans (cdr x) 0 1))) (entget e)))
)
(defun mkline (pt1 pt2) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))))
(defun new_ss (lastobj / ss obj)
(setq ss (ssadd))
(setq obj (entnext lastobj))
(while obj
(setq ss (ssadd obj ss))
(setq obj (entnext obj))
)
ss
)
(defun ss2lst ( ss / i l )
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
(defun c:tt ( / a angint ar ar1 bang box cont dd dh dx e e0 ee h h1 lm lstr0 m1 n odlst p1 p2 pa pb pc pm pm1 pts ssn str tm w x)
(progn
(vl-load-com)
(setq odlst (mapcar 'getvar '("cmdecho" "osmode")))
(mapcar 'setvar '("cmdecho" "osmode") '(0 0))
(setq cont T)
(while cont
(setq str (getstring "\n输入面积划分表<800.22,200,330.45...>"))
(if (/= str "")(setq cont nil))
)
(setq lstr0 (mapcar 'atof (str2lst str ","))
n (apply '+ lstr0)
e (car (entsel "\n选择多段线:"))
p1 (getpoint "\n地块划分起点:")
p2 (getpoint p1 "\n划分方向:")
bang (angle p1 p2)
pc (ptscen (gvp e))
ar (Vlax-Get (Vlax-Ename->Vla-Object e) 'Area )
lstr0 (mapcar '(lambda(x) (* x (/ ar n))) lstr0)
lstr0 (reverse (cdr (reverse lstr0)))
angint (atof (angtos bang 0 4))
lm nil
ee (entlast)
)
(vl-cmdf "_.rotate" e "" pc (- 90. angint))
(setq box (ebox e)
p1 (car box)
p2 (cadr box)
)
(mapcar 'set '(w h) (mapcar '- p2 p1))
(vla-copy (vlax-ename->vla-object e))
(setq e0 (entlast))
(entdel e0)
)
(foreach a lstr0
(setq dh (/ a w)
pa (mapcar '+ p1 (list 0 dh))
pb (mapcar '+ p1 (list w dh))
tm (mkline (mapcar '- pa (list 10 0)) (mapcar '+ pb (list 10 0)))
pts (2epi tm e 0)
pm (mid (car pts) (last pts))
pm1 (mapcar '- pm (list 0 (* 0.5 dh)))
)
(vl-cmdf "boundary" "a" "b" "n" e tm "" "" pm1 "")
(setq m1 (entlast)
ar1 (Vlax-Get (Vlax-Ename->Vla-Object m1) 'Area )
dx (- a ar1)
dd (/ dx w 2.)
)
(while (not (equal dx 0 1e-3))
(mapcar 'entdel (list tm m1))
(setq pa (mapcar '+ pa (list 0 dd))
pb (mapcar '+ pb (list 0 dd))
tm (mkline pa pb)
pts (2epi tm e 0)
pm (mid (car pts) (last pts))
pm1 (mapcar '- pm (list 0 (* 0.5 dh)))
)
(vl-cmdf "boundary" "a" "b" "n" e tm "" "" pm1 "")
(setq m1 (entlast)
ar1 (Vlax-Get (Vlax-Ename->Vla-Object m1) 'Area )
dx (- a ar1)
dd (/ (abs dx) w 2.)
)
)
(vl-cmdf "boundary" "a" "b" "n" e tm "" "" (mapcar '+ pm (list 0 (* 0.5 dh))) "")
(mapcar 'entdel (list e tm m1))
(setq e (entlast)
h1 (abs (p2ld p1 pa pb))
p1 (mapcar '+ p1 (list 0 h1))
lm (cons pts lm)
)
)
(mapcar '(lambda(x) (mkline (car x) (cadr x))) lm)
(mapcar 'entdel (list e e0))
(setq ssn (new_ss ee))
(vl-cmdf "_.rotate" e0 ssn "" pc (- (- 90. angint)))
(mapcar 'setvar '("cmdecho" "osmode") odlst)
)
试试看 参考
页:
[1]