交点生成墙柱，或者点选生成墙柱
交点生成墙柱，或者点选生成墙柱，怎么填充成墙柱？？？;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)
(setq pl(vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
(while pl
(setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
pl (cdr (cdr (cdr pl)))
)
)
pts
)
;;;曲线选择集交点
(defun ssinters (ss / pts en1 en2)
(while (> (sslength ss) 1)
(setq en1 (ssname ss 0))
(ssdel en1 ss)
(setq n (sslength ss))
(repeat n
(setq en2 (ssname ss (setq n (1- n))))
(setq pts (append pts (Curveinters en1 en2)))
)
)
pts
)
;;;画框
(defun drawbox (pt d / r en ang)
(setq en (ssget pt '((0 . "*line"))))
(setq en (ssname en 0))
(setq ang (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (setq pt (vlax-curve-getclosestpointto en pt)))))))
(setq r (* d (sqrt 2)))
;;此处也可改插入框的图块
(command "rectang" (polar pt (* pi 1.25) r) (polar pt (* pi 0.25) r ) )
(command "rotate" (entlast) "" pt (/ (* 180 ang) pi))
)
;;;使用实例
(defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho)
(setq os (getvar "osmode"))
(setq cmdecho (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq d (getreal "\n插入框大小<600.0>"))
(if (null d) (setq d 1.))
(while (and
(setq p1 (getpoint "\n选择图框左下角："))
(setq p2 (GETCORNER p1 "\n选择图框左下角："))
)
(setq minX (apply 'min (mapcar 'car (list p1 p2)))
minY (apply 'min (mapcar 'cadr (list p1 p2)))
maxX (apply 'max (mapcar 'car (list p1 p2)))
maxY (apply 'max (mapcar 'cadr (list p1 p2)))
)
(grvecs (list 1 (list minx miny) (list maxx miny)
1 (list maxx miny) (list maxx maxy)
1 (list maxx maxy) (list minx maxy)
1 (list minx maxy) (list minx miny)
)
)
(setq ss (ssget "c" p1 p2 '((0 . "*line"))))
(if ss
(progn
(setq pts (ssinters ss))
(if pts
(foreach pt pts
(if (and (>= maxX (car pt) minX)
(>= maxY (cadr pt) minY)
)
(drawbox pt d)
)
)
)
)
(princ "\n ***回车键结束***")
)
(setvar "osmode" os)
(setvar "cmdecho" cmdecho)
(princ)
)
将：
;;;画框
(defun drawbox (pt d / r en ang)
(setq en (ssget pt '((0 . "*line"))))
(setq en (ssname en 0))
(setq ang (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (setq pt (vlax-curve-getclosestpointto en pt)))))))
(setq r (* d (sqrt 2)))
;;此处也可改插入框的图块
(command "rectang" (polar pt (* pi 1.25) r) (polar pt (* pi 0.25) r ) )
(command "rotate" (entlast) "" pt (/ (* 180 ang) pi))
)
改为：
;;;画框
(defun drawbox (pt d / r en ang)
(setq en (ssget pt '((0 . "*line"))))
(setq en (ssname en 0))
(setq ang (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (setq pt (vlax-curve-getclosestpointto en pt)))))))
(setq r (* d (sqrt 2)))
;;此处也可改插入框的图块
(command "rectang" (polar pt (* pi 1.25) r) (polar pt (* pi 0.25) r ) )
(setq ent (entlast))
(command "rotate" ent "" pt (/ (* 180 ang) pi))
(command "_bhatch" "p" "SOLID" "s" ent "" "")
)
yshf 发表于 2019-7-24 10:43
将：
;;;画框
(defun drawbox (pt d / r en ang)
谢谢 :handshake
页:
[1]