线割外形穿线孔绘制
本帖最后由 yu960312 于 2022-5-15 03:32 编辑(defun C:AC(/ en P1 P2 P3 P4 P5)
(COMMAND "UCS" "W")
(setvar "cmdecho" 0)
(setvar "cecolor" "1");改变当前颜色
(setvar "ORTHOMODE" 0);关闭正交
(if (null L)(setq L 2.0))
(if (null W)(setq W 2.0))
(if (null R)(setq R 0.5))
(while ;循环执行
(setq L11 L W11 W R11 R)
(setq T 0)
(while (/= T nil) ;循环设置参数
(princ "\n---绘制穿丝孔---")
(princ (strcat "\n当前设置[ 引线: " (rtos L 2 4) " MM "))
(princ (strcat "偏距: " (rtos W 2 4) " MM "))
(princ (strcat "半径: " (rtos R 2 4) " MM ] "))
(initget "LL WW RR")
(setq en(entsel "\n选择线段或[引线(LL) /偏距(WW) /半径(RR)]"))
(cond
((= en "LL");L
(progn
(setq L(getreal (strcat "\n引线:<" (rtos L 2 4) ">")))
(if (= nil L)(setq L L11))
)
)
((= en "WW");W
(progn
(setq W(getreal (strcat "\n偏距:<" (rtos W 2 4) ">")))
(if (= nil W)(setq W W11))
)
)
((= en "RR");R
(progn
(setq R(getreal (strcat "\n半径:<" (rtos R 2 4) ">")))
(if (= nil R)(setq R R11))
)
)
((/= en "LL")(/= en "WW")(/= en "RR")
(setq T nil)
)
);结束cond
);结束循环设置参数
(if (= en nil)(exit))
(setq e (car en))
(setq enn (entget (car en)))
(setq ol(cdr (assoc 0 enn)))
(if (= ol "LWPOLYLINE")
(progn
(setq n(fix (vlax-curve-getparamatpoint e
(vlax-curve-getclosestpointto e (cadr en)))));点选在多段线上的第几段
(setq n1(vlax-curve-getclosestpointto e (cadr en)));点选的点在多段线上的位置
(setq P1(vlax-curve-getpointatparam e n));第一个端点坐标
(setq P2(vlax-curve-getpointatparam e (1+ n)));第二个端点坐标
))
(if (= ol "LINE")
(progn
(setq n1(vlax-curve-getclosestpointto e (cadr en)));点选的点在多段线上的位置
(setq P1(cdr (assoc 10 enn)));第一个端点坐标
(setq P2(cdr (assoc 11 enn)));第二个端点坐标
))
(setq MI(polar P1 (angle P1 P2) (* 0.5 (distance P1 P2))));线段中点坐标
(setq P3 (getpoint "\n指定一侧上的点:"))
(setq A2 (distance P1 N1));第一点到点选的点的距离
(setq A3 (distance P2 N1));第二点到点选的点的距离
(if (> A2 A3)
(progn
(setq P2P P2)
(setq P1P P1)
(setq P1 P2P)
(setq P2 P1P)
)
)
(setq ang1 (atof (angtos (angle P1 P2) 0 4)));获取点选线段的倾斜角度
(setq ang2(anga P1 P3 MI));获取点夹角角度为
;判断象限
(if (and (> ang2 90 ) (< ang2 180)) (SETQ XX 1));第一象限
(if (and (> ang2 0) (< ang2 90 )) (SETQ XX 2));第二象限
(if (and (> ang2 270) (< ang2 360)) (SETQ XX 3));第三象限
(if (and (> ang2 180) (< ang2 270)) (SETQ XX 4));第四象限
(cond
((= XX 1);第一象限
(progn
(setq P4(polar P2 (* pi (/ (angtof (rtos ang1) 0) (angtof (rtos 180) 0))) (* W -1)))
(setq P5(polar P4 (* pi (/ (angtof (rtos (+ 270 ang1)) 0) (angtof (rtos 180) 0))) (* L -1)))
))
((= XX 2);第二象限
(progn
(setq P4(polar P1 (* pi (/ (angtof (rtos ang1) 0) (angtof (rtos 180) 0))) W))
(setq P5(polar P4 (* pi (/ (angtof (rtos (+ 270 ang1)) 0) (angtof (rtos 180) 0))) (* L -1)))
))
((= XX 3);第三象限
(progn
(setq P4(polar P1 (* pi (/ (angtof (rtos ang1) 0) (angtof (rtos 180) 0))) W))
(setq P5(polar P4 (* pi (/ (angtof (rtos (+ 270 ang1)) 0) (angtof (rtos 180) 0))) L))
))
((= XX 4);第四象限
(progn
(setq P4(polar P2 (* pi (/ (angtof (rtos ang1) 0) (angtof (rtos 180) 0))) (* W -1)))
(setq P5(polar P4 (* pi (/ (angtof (rtos (+ 270 ang1)) 0) (angtof (rtos 180) 0))) L))
))
)
(entmakex (list '(0 . "CIRCLE") (cons 10 P5) (cons 40 R)))
(princ "\n")
(princ "绘制完毕!")
);结束循环绘制
(princ)
)
(defun anga(PT1 PT2 PT3);已知PT1 PT2 PT3 三点，求三点夹角A角度
(setq ang(- (angle PT1 PT3) (angle PT2 PT3)))
(if (> ang (* 2.0 pi)) (setq ang(- (* 2.0 pi) ang)))
(setq ang(atof (angtos ang 0 4)))
)
yu960312 发表于 2022-5-15 08:49
慢走丝呀，外形要修刀呀
我也是慢走丝，我的意思为什么要靠角落偏移固定距离。直接指定一个点，往里或者往外拉一个固定距离不就完事了。， 仿写了一个，凑个热闹。
(defun c:ac (/ N OLDOR OLDOS P1 P11 P2 P22 P33 P44 PMD PP SS SSNA SSP1 X
Y)
(setq oldos (getvar "osmode"))
(setq oldor (getvar "orthomode"))
(defun PickClosePt (obj p);;;多段线所点击点最近的一个顶点
(setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n(fix (vlax-curve-getparamatpoint obj pp))
)
(setq p1 (vlax-curve-getPointAtParam obj n))
(setq p2 (vlax-curve-getPointAtParam obj (1+ n)))
(if (< (distance pp p1) (distance pp p2))
p1
p2
)
)
(princ "\n请选择要画穿线孔的多义线：")
(if (and (setq ss (entsel))
(= (cdr (assoc 0 (entget (car ss)))) "LWPOLYLINE")
)
(progn
(setvar "osmode" 0)
(setvar "orthomode" 1)
(setq ssna (vlax-ename->vla-object (car ss)))
(setq ssp1 (cadr ss))
(setq p11 (PickClosePt ssna ssp1))
(setq pmd (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2))
(cond ((and (= (cadr p11) (cadr pmd)) (> (car p11) (car pmd)))
(setq p22 (list (- (car p11) 2.0) (cadr p11)))
);;;2.0为起割点距离
((and (= (cadr p11) (cadr pmd)) (< (car p11) (car pmd)))
(setq p22 (list (+ (car p11) 2.0) (cadr p11)))
)
((and (= (car p11) (car pmd)) (> (cadr p11) (cadr pmd)))
(setq p22 (list (car p11) (- (cadr p11) 2.0)))
)
((and (= (car p11) (car pmd)) (< (cadr p11) (cadr pmd)))
(setq p22 (list (car p11) (+ (cadr p11) 2.0)))
)
)
(princ "\n请选择下一点：")
(if (setq p33 (getpoint p22))
(progn
(cond ((and (= (cadr p33) (cadr p22)) (> (car p33) (car p22)))
(setq p44 (list (+ (car p22) 2.0) (cadr p22)))
);;;2.0为起割点到穿丝孔距离
((and (= (cadr p33) (cadr p22)) (< (car p33) (car p22)))
(setq p44 (list (- (car p22) 2.0) (cadr p22)))
)
((and (= (car p33) (car p22)) (> (cadr p33) (cadr p22)))
(setq p44 (list (car p22) (+ (cadr p22) 2.0)))
)
((and (= (car p33) (car p22)) (< (cadr p33) (cadr p22)))
(setq p44 (list (car p22) (- (cadr p22) 2.0)))
)
)
(entmake
(list '(0 . "LINE") (cons 10 p22) (cons 11 p44) (cons 62 1))
)
(entmake (list '(0 . "Circle")
(cons 10 p44)
(cons 40 0.5);;;0.5为穿丝孔半径
(cons 62 1)
)
)
(setvar "osmode" oldos)
(setvar "orthomode" oldor)
)
(progn (princ "\n未选择到点，程序结束!")
(setvar "osmode" oldos)
(setvar "orthomode" oldor)
)
)
)
(progn (princ "\n未选择到图形或图形不是多义线,程序结束!")
(setvar "osmode" oldos)
(setvar "orthomode" oldor)
)
)
(princ)
) 各位帮忙给看看是怎么回事？
一是退出命令时提示错误：quit / exit abort。这个倒没什么影响。
二是执行完命令后，再新建文件会提示：**express tools**-unable to load acetutil.arx ，必须重启CAD才能解决。
谢谢楼主，这个我们很需要。谢谢你的无私分享。 大师，我想问一下，这个程序能不能改改。现在只能产生一个圆 能不能一同产生一个引入线，，从圆心垂直倒多义线的引入线 我也是线割行业，你的插件为什么要有偏移距离。 zm880928 发表于 2022-5-15 08:46
我也是线割行业，你的插件为什么要有偏移距离。
慢走丝呀，外形要修刀呀 ninja37 发表于 2022-5-15 08:28
大师，我想问一下，这个程序能不能改改。现在只能产生一个圆 能不能一同产生一个引入线，，从圆心垂直倒 ...
你是做快走丝的吧 收藏学习了 感谢楼主
zm880928 发表于 2022-5-15 08:50
你是做快走丝的吧
快丝没做过中丝慢丝都做过
页:
[1]
2