|
理想:点击内空,移动鼠标,根据鼠标与点击点的距离 来自动调整等分数量,根据鼠标的方向自动变化等分的方向
进阶理想:二次单击鼠标左键,确定等分的数量和方向后,将等分线由单线变成双线。并根据鼠标的位置调整双线之间的距离!
我感觉离目标已经不远了,跟我说说,再绘制了一次等分后,移动鼠标,如何删除上一次等分,然后更新新的等分。
动态等分.lsp
(defun C:t4( / )
(YL_begin)
(if (setq pta (getpoint "\n层板位置"))
(progn
(setq ent0 (entlast))
(COMMAND "-BOUNDARY" pta "")
(mc:wk (last_ent ent0))
(setq ent (entlast))
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))));提取多段线坐标
(setq p1 (car ss) p2 (cadr ss) p3 (caddr ss) p4 (cadddr ss) pz (Mc:Md p1 p3) H (distance P1 P4) W (distance P1 P2))
)
)
(setq bb T)
(while bb
(setq mouse (grread t 12 0))
(setq a (car mouse) aa (cadr mouse))
(cond
((= 5 a)
(PROGN
(setq R (MC:ROZ (angle Pz AA))
d (distance Pz AA)
dd (distance p1 p3)
)
(if (> 2 (setq n (fix (atof (MC:RTOSZ (/ (* d 10) dd))))))
(setq n 2))
(if (/= n nn)
(PROGN
(COMMAND "_.erase" (last_ent ent0) "")
(mc:EQ-LINE P1 P2 P3 P4 n R)
(setq nn n))
)
)
)
((or (= 3 a);左键
(= 25 a) (= 11 a) ;右键
(and (= a 2) (= aa 13));回车
(and (= a 2) (= aa 32));或空格.
)
(setq bb nil)
)
);cond
)
(setq cb (getdist aa "设置层板厚度"))
(if (/= cb nil)
(PROGN
(if (= r 0)
(setq pa p1 pb p4 k w)
(setq pa p1 pb p2 k h)
)
(COMMAND "_.erase" (last_ent ent0) "")
(repeat (1- n)
(setq pa (polar Pa R (/ (- k (* cb(1- n))) n)))
(setq pb (polar Pb R (/ (- k (* cb(1- n))) n)))
(setq pc (polar Pb R cb))
(setq pd (polar Pa R cb))
(Mc:spl (list pa pb pc pd))
(setq pa pd pb pc)
)
)
)
(YL_end)
(princ)
)
;;点表生成多段线
(defun Mc:spl (lst / pt)
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
)
;;在指定区域内绘图
(defun mc:EQ-LINE (PT1 PT2 PT3 PT4 n r / nww nhh)
(SETQ HH (distance PT1 PT4) WW (distance PT1 PT2))
(if (= r 0)
(PROGN
(PROGN
(SETQ Nww (/ ww n))
(repeat (1- n)
(setq Pt1 (polar Pt1 R nww))
(setq Pt4 (polar Pt4 R nww))
(mc:zx pt1 pt4)
)
)
)
(PROGN
(SETQ NHH (/ HH n))
(repeat (1- n)
(setq Pt1 (polar Pt1 R nhh))
(setq Pt2 (polar Pt2 R nhh))
(mc:zx pt1 pt2)
)
)
))
;;四舍五入取整
(defun MC:RTOSZ (STR / )
(setq STR (rtos STR 2 0))
)
;;;两点画直线
(defun Mc:ZX (PT1 PT2 /)
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
)
;;返回垂直或水平方向
(defun Mc:roz ( R / )
(IF
(or (< (* 0.25 pi) R (* 0.75 pi))
(< (* 1.25 pi) R (* 1.75 pi))
)
(SETQ R (* PI 0.5))
(SETQ R 0)
)
)
;;;;===============================必备函数=============================
;;*****************************************************************************
;;功 能:绘图程序的初始化处理,记录当前层名、线型、颜色、捕捉方式、文本样式、文本高度,
;; 控制点标记可见方式、主单位值消零处理方式、命令行回显方式、然后关闭目标捕捉,
;; 设置线形随层、颜色随层、设置命令行不回显、不显示控制点标记、对主单位值后续零作消零处理
;;说 明:和函数YL_end配对使用。
(defun YL_begin ()
(setq oderr *error*) ;;保存原来的*error*
(setq *error* YL_err) ;;将*error*用自己的错误处理函数替代
(setq odltp (getvar "celtype")) ;;记录当前线型设置
(setq odclr (getvar "cecolor")) ;;记录当前颜色设置
(setq odosm (getvar "osmode")) ;;记录当前捕捉方式
(setq odlay (getvar "clayer")) ;;记录当前层
(setq odsty (getvar "textstyle")) ;;记录当前文本样式
(setq odtsz (getvar "textsize")) ;;记录当前文本高度
(setq odbpm (getvar "blipmode")) ;;记录当前控制点标记是否可见
(setq odzin (getvar "dimzin")) ;;记录主单位值消零处理方式
(setq odcmd (getvar "cmdecho")) ;;记录命令行回显方式
(setvar "celtype" "bylayer") ;;设置线形随层
(setvar "cecolor" "bylayer") ;;设置颜色随层
(setvar "cmdecho" 0) ;;设置命令行不回显
(setvar "blipmode" 0) ;;不显示控制点标记
(setvar "dimzin" 8) ;;对主单位值后续零作消零处理,因为DIMZIN 对 AutoLISP rtos 和 angtos 函数执行实数向字符串转换操作有影响。
(setvar "osmode" 0) ;;关闭对象捕捉方式
)
;;*****************************************************************************
;;YL_end
;;功 能:程序结束,恢复程序开始前的设置。
;; 恢复YL_begin设置的系统变量表中的数值。
;;说 明:和函数YL_begin配对使用。
(defun YL_end ()
(setvar "celtype" odltp)
(setvar "cecolor" odclr)
(setvar "osmode" odosm)
(setvar "textstyle" odsty)
(setvar "textsize" odtsz)
(setvar "blipmode" odbpm)
(setvar "dimzin" odzin) ;;恢复主单位值消零处理方式
(setvar "cmdecho" odcmd)
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)
;;*****************************************************************************
;;YL_err
;;功 能:错误处理函数。
(defun YL_err (msg)
(princ (strcat "\n错误:" msg "\n")) ;;打印错误原因
(YL_end) ;;调用函数YL_end恢复程序开始前的设置
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)
;;39外框
(defun mc:wk (ss / oldos oldla lst n obj minx miny maxx maxy pt1
pt2 pt3 pt4)
(setq oldos (getvar "osmode"))
(setq oldla (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(vla-getboundingbox obj 'x 'y)
(setq lst (cons (vlax-safearray->list y)
(cons (vlax-safearray->list x) lst)
)
)
)
(setq minx (car (vl-sort (mapcar 'car lst) '<))
miny (car (vl-sort (mapcar 'cadr lst) '<))
maxx (car (vl-sort (mapcar 'car lst) '>))
maxy (car (vl-sort (mapcar 'cadr lst) '>))
)
(setq pt1 (list minx miny))
(setq pt2 (list maxx miny))
(setq pt3 (list maxx maxy))
(setq pt4 (list minx maxy))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 pt1) (cons 10 pt2) (cons 10 pt3) (cons 10 pt4)))
(setvar "osmode" oldos)
(setvar "clayer" oldla)
(setvar "cmdecho" 1)
(princ)
)
;;40最后生产出的图元
(defun last_ent (en / ss)
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(ssadd en ss)
);if
);while
(if (zerop (sslength ss)) (setq ss nil))
ss
);progn
(ssget "_x")
);if
)
;两点中
(defun Mc:Md (pt1 pt2 / ptn)
(setq ptn (mapcar'(lambda(X Y)(/(+ X Y)2.0)) pt1 pt2))
)
层板jj.lsp
(defun C:jj( / ent0 ent ss p1 p2 p3 p4 pz h w a aa d dd n nn nm mouse r )
(YL_begin)
(if (setq pta (getpoint "\n层板位置"))
(progn
(setq ent0 (entlast))
(COMMAND "-BOUNDARY" pta "")
(mc:wk (last_ent ent0))
(setq ent (entlast))
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))));提取多段线坐标
(setq p1 (car ss) p2 (cadr ss) p3 (caddr ss) p4 (cadddr ss) pz (Mc:Md p1 p3) H (distance P1 P4) W (distance P1 P2))
)
)
(setq bb T)
(while bb
(setq mouse (grread t 12 0))
(setq a (car mouse))
(if( /= a 3) (setq aa (cadr mouse)) (setq aa nil))
(cond
((= 5 a)
(PROGN
(setq R (MC:ROZ (angle Pz AA))
d (distance Pz AA)
dd (distance p1 p3)
)
(if (> 2 (setq n (fix (atof (MC:RTOSZ (/ (* d 10) dd))))))
(setq n 2))
(if (/= n nn)
(PROGN
(mc:EQ-LINE P1 P2 P3 P4 n R)
(setq ptmin (car (viewpnts)) ptmax (cadr (viewpnts)))
(entmake (list '(0 . "TEXT") (cons 1 (itoa n)) (cons 10 aa) (cons 40 (/ (distance ptmin ptmax) 80))(cons 62 3)))
(Mc:ZXc pz aa 3)
(setq nn n nm nn)
)
)
)
)
((equal mouse '(2 50))
(PROGN (setq nm 2)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 51))
(PROGN (setq nm 3)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 52))
(PROGN (setq nm 4)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 53))
(PROGN (setq nm 5)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 54))
(PROGN (setq nm 6)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 55))
(PROGN (setq nm 7)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 56))
(PROGN (setq nm 8)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((equal mouse '(2 57))
(PROGN (setq nm 9)
(mc:EQ-LINE P1 P2 P3 P4 nm R)))
((or (= 3 a);左键
(= 25 a) (= 11 a) ;右键
(and (= a 2) (= aa 13));回车
(and (= a 2) (= aa 32));或空格.
)
(setq bb nil)
)
);cond
)
(mc:cbl p1 p2 p4 nm r)
(YL_end)
(princ)
)
;;在指定区域内绘直线
(defun mc:EQ-LINE (PT1 PT2 PT3 PT4 n r / nww nhh)
(COMMAND "_.erase" (last_ent ent0) "")
(SETQ HH (distance PT1 PT4) WW (distance PT1 PT2))
(if (= r 0)
(PROGN
(PROGN
(SETQ Nww (/ ww n))
(repeat (1- n)
(setq Pt1 (polar Pt1 R nww))
(setq Pt4 (polar Pt4 R nww))
(mc:zx pt1 pt4)
)
)
)
(PROGN
(SETQ NHH (/ HH n))
(repeat (1- n)
(setq Pt1 (polar Pt1 R nhh))
(setq Pt2 (polar Pt2 R nhh))
(mc:zx pt1 pt2)
)
)
))
;;在指定区域内绘矩形
(defun mc:cbl (p1 p2 p4 n r / pa pb pc pd cb)
(setvar "OSMODE" 6079)
(setq cb (getdist "设置层板厚度"))
(if (/= cb nil)
(progn
(if (= r 0)
(setq pa p1 pb p4 k w)
(setq pa p1 pb p2 k h)
)
(COMMAND "_.erase" (last_ent ent0) "")
(repeat (1- n)
(setq pa (polar Pa R (/ (- k (* cb(1- n))) n)))
(setq pb (polar Pb R (/ (- k (* cb(1- n))) n)))
(setq pc (polar Pb R cb))
(setq pd (polar Pa R cb))
(Mc:spl (list pa pb pc pd pa))
(setq pa pd pb pc)
)
(mc:newlayer "F-家具内线" 252 "Continuous")
(mc:ggtc (last_ent ent0) "F-家具内线") ))
) |
|