[lisp] 绘制箭头程序（直箭头，弯箭头，大弯箭头）
(defun C:jt()
(prompt "\n绘制箭头")
(setvar "cmdecho" 0)
(setq oldmode (getvar "osmode"))
(setvar "osmode" 0);关闭扑捉
(initget "A B C")
(setq enda (getkword "\n直箭头A/弯箭头B/大弯箭头<C> <A>")
enda (if enda enda "A"))
(while (setq p1 (getpoint "\n箭头的尖端位置:")
p2 (getpoint p1 "\n箭头的另一端:")
dd (distance p1 p2))
(prompt (rtos dd 2 4))
(setq w (* dd 1.2)
an (angle p1 p2)
p3 (polar p2 (+ an (* pi 0.5)) (/ w 2.0))
p4 (polar p2 (+ an (* pi 1.5)) (/ w 2.0)))
(if (= enda "A")
(progn
(command "solid" p1 p3 p1 p4 ""
"pline" p2 "w" (* w 0.4) (* w 0.4) (polar p2 an (getdist p2)) "")
)
)
(if (= enda "B")
(command "pline" p1 "w" "0" w p2 "w" (* w 0.4) (* w 0.4) "a" pause "")
)
(if (= enda "C")
(command "pline" p1 "w" "0" w p2 "w" (* w 0.4) (* w 1.2) "a" pause "")
)
(if (= p1 nil) (exit))
)
(setvar "osmode" oldmode)
(prin1)
) ;;;;;;;;;;;;;;;;;;;;;;;;箭头工具
(defun C:jt()
(prompt "\n绘制箭头")
(setvar "cmdecho" 0)
(setq oldmode (getvar "osmode"))
(setvar "osmode" 0);关闭扑捉
(initget "A B C")
(setq enda (getkword "\n直箭头A/弯箭头B/大弯箭头<C> <A>")
enda (if enda enda "A"))
(while (setq p1 (getpoint "\n箭头的尖端位置:"))
(setq p2 (getpoint p1 "\n箭头的另一端:")
dd (distance p1 p2))
(prompt (rtos dd 2 4))
(setq w (* dd 1.0)
an (angle p1 p2)
p3 (polar p2 (+ an (* pi 0.5)) (/ w 4.0))
p4 (polar p2 (+ an (* pi 1.5)) (/ w 4.0)))
(if (= enda "A")
(progn
(command "solid" p1 p3 p1 p4 ""
"pline" p2 "w" (* w 0.2) (* w 0.2) (polar p2 an (getdist p2)) "")
)
)
(if (= enda "B")
(progn
(command "solid" p1 p3 p1 p4 ""
"pline" p2 "w" "0" w p2 "w" (* w 0.2) (* w 0.2) "a" pause "")
)
)
(if (= enda "C")
(progn
(command "solid" p1 p3 p1 p4 ""
"pline" p2 "w" "0" w p2 "w" (* w 0.2) (* w 0.6) "a" pause "")
)
)
(if (= p1 nil) (exit))
)
(setvar "osmode" oldmode)
(prin1)
) (defun c:tt ()
(vl-load-com)
(setq acad (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acad))
(setq mspace (vla-get-modelspace acaddocument))
(setq h (getreal "\n请输入偏移距离"))
(setq endata (entsel "\n请选择一条线"))
(setq ename (car endata))
(setq p0 (cadr endata))
(setq obj (vlax-ename->vla-object ename))
(setq l1 (car (vlax-safearray->list (vlax-variant-value (vla-offset obj h))))) ;偏移曲线1
(setq l2 (car (vlax-safearray->list (vlax-variant-value (vla-offset obj (* -1 h)))))) ;偏移曲线2
(setq p1 (vlax-curve-getclosestpointto l1 p0 t)) ;插入点1
(setq p2 (vlax-curve-getclosestpointto l2 p0 t)) ;插入点2
(vla-delete l1) ;删除曲线1
(vla-delete l2) ;删除曲线2
(setq ang1 (angle p2 p1));插入点1 点2角度
(setq ang2 (- ang1 (/ pi 2)));计算直线角度或者曲线的切线角度
(setq obj (vla-insertblock mspace (vlax-3d-point p2) "11005" 1 1 1 ang2)) ;插入块名为11005的图块
(setq loop t)
(while loop
(setq code (grread t 8))
(cond
((= (car code) 5)
(setq ang3 (- (angle p0 (cadr code)) ang2)) ;光标所在点与单选点的角度减去直线的或者曲线切线的角度
(if (< ang3 0)
(setq ang3 (+ ang3 (* 2 pi))))
(cond
((and (> ang3 0 ) (< ang3(/ pi 2)))
(vla-put-Rotation obj ang2)
(vla-put-insertionpoint obj (vlax-3d-point p1))
)
((and (> ang3 (/ pi 2)) (< ang3 pi))
(vla-put-Rotation obj (- ang2 pi))
(vla-put-insertionpoint obj (vlax-3d-point p1))
)
((and (> ang3 pi) (< ang3(* 3 (/ pi 2))))
(vla-put-Rotation obj (- ang2 pi))
(vla-put-insertionpoint obj (vlax-3d-point p2))
)
((and (> ang3 (* 3 (/ pi 2))) (< ang3(* 2 pi)))
(vla-put-Rotation obj ang2)
(vla-put-insertionpoint obj (vlax-3d-point p2))
)
)
)
((= code '(25 37)) (vla-delete obj))
(T (setq loop nil))
)
)
) (defun c:crtk ()
(vl-load-com)
(setq acad (vlax-get-acad-object))
(setq acaddocument (vla-get-activedocument acad))
(setq mspace (vla-get-modelspace acaddocument))
(if (not (setq bl_data (vlax-ldata-get "bl_tools" "bl"))) ;读取本函数保存在图档中的数据，如果bl_data返回为空值，说明第一次运行本程序
(progn
;第一次运行本程序，为确保程序正确运行，需要建立一个默认的原始数据。这个数据主要用于保存上次的设置，以便下次调用
;数据格式为一个点对表，格式为：
(setq bl_data (list '(1 . 1) '(2 . 0) '(3 . "")));初始值(1.缩放系数)(2.偏移值)(3.块名)
;创建默认数据
(vlax-ldata-put "bl_tools" "bl" bl_data) ;将默认数据保存到图档的字典中，以便下次调用
)
)
(setq s (cdr (assoc 1 bl_data)) ;取出缩放系数
h (cdr (assoc 2 bl_data)) ;取出偏移值
enblb (cdr (assoc 3 bl_data)) ;取出块名
);恢复设置数据
(setq gr t)
(while gr ;获取用户动作，在用户点击左键后退出循环
(if(/= enblb "")
(progn
(initget "t r")
(setq endata (entsel (strcat"\n选择线[选择图块(t)][输入图块名(r)]:当前块<"(cdr (assoc 3 bl_data))">")))
);progn11
(progn
(initget "t")
(setq enbl (getstring (strcat"\n输入图块名[选择图块(t)]当前块:<"(cdr (assoc 3 bl_data))">")))
(if(= enbl "t")
(progn
(setq enbl (entsel (strcat"\n选择块:当前块<"(cdr (assoc 3 bl_data))">")))
(setq enbla (entget (car enbl)))
(setq enblb (cdr (assoc 2 enbla)))
(vlax-ldata-put "bl_tools" "bl" (setq bl_data (subst (cons 3 enblb) (assoc 3 bl_data) bl_data)))
(setq endata (entsel (strcat"\n选择线:当前块<"(cdr (assoc 3 bl_data))">")))
);progn21
(progn
(command "pline" '(800 0) "w" "0" "400" '(00) "")
(command "block" enbl'(0 0 ) (entlast) "")
(setq enblb enbl)
(vlax-ldata-put "bl_tools" "bl" (setq bl_data (subst (cons 3 enblb) (assoc 3 bl_data) bl_data)))
(setq endata (entsel (strcat"\n选择线:当前块<"(cdr (assoc 3 bl_data))">")) ));progn22
);if2
);progn12
);if1
(if(= endata "t")
(progn
(setq enbl (entsel (strcat"\n选择块:当前块<"(cdr (assoc 3 bl_data))">")))
(setq enbla (entget (car enbl)))
(setq enblb (cdr (assoc 2 enbla)))
(vlax-ldata-put "bl_tools" "bl" (setq bl_data (subst (cons 3 enblb) (assoc 3 bl_data) bl_data)))
(setq endata (entsel (strcat"\n选择线:当前块<"(cdr (assoc 3 bl_data))">")))
);progn31
);if3
(if(= endata "r")
(progn
(setq enbl (getstring (strcat"\n输入图块名:当前块<"(cdr (assoc 3 bl_data))">")))
(setq enblb enbl)
(vlax-ldata-put "bl_tools" "bl" (setq bl_data (subst (cons 3 enblb) (assoc 3 bl_data) bl_data)))
(setq endata (entsel (strcat"\n选择线:当前块<"(cdr (assoc 3 bl_data))">")))
);progn41
);if4
(if (= endata nil)
(setq gr nil)
(progn
(setq p0 (cadr endata))
(setq l1 (vlax-ename->vla-object (car endata)))
(setq p1 (vlax-curve-getclosestpointto l1 p0 t))
(setq ang1 (angle p1 (mapcar '+ p1 (vlax-curve-getfirstderiv l1 (vlax-curve-getparamatpoint l1 p1)))))
(setq p2 (polar p1 (+ ang1 (/ pi 2)) h))
(setq p3 (polar p1 (- ang1 (/ pi 2))h))
(setq obj (vla-insertblock mspace (vlax-3d-point p2) enblb s s s ang1))
(setq loop t)
(princ (strcat"\n指定图块位置或[偏移距离(O)<" (rtos h) ">/缩放(S)]<" (rtos s) ">"))
(setq YH_mouse (grread T 5 0)) ;获取当前鼠标坐标。getpoint，grread等得到的点都是相对于用户的UCS坐标系的
(while (/= (car (setq YH_mouse (grread YH_mouse 1 0))) 3) ;获取用户动作，在用户点击左键后退出循环
(cond
((= (car YH_mouse) 2) ;键盘输入
(setq YH_keyb (strcase (chr (cadr YH_mouse))))
(cond
((= YH_keyb "O") ;用户键入的是O键，响应修改偏移距离
(setq h (getreal (strcat "\n输入偏移距离:当前值<" (rtos h) ">")))
(if (/= h nil)
(progn
(vlax-ldata-put "bl_tools" "bl" (setq bl_data (subst (cons 2 h) (assoc 2 bl_data) bl_data)))
(setq p2 (polar p1 (+ ang1 (/ pi 2)) h))
(setq p3 (polar p1 (- ang1 (/ pi 2)) h))
);progn
);if
);or21
((= YH_keyb "S") ;用户键入的是S键，响应修改大小
(setq s (getreal (strcat "\n输入缩放系数:当前值<" (rtos s) ">")))
(if (/= s nil)
(progn
(vlax-ldata-put "bl_tools" "bl" (setq bl_data (subst (cons 1 s) (assoc 1 bl_data) bl_data)))
(vla-delete obj)
(setq obj (vla-insertblock mspace (vlax-3d-point p2) enblb s s s ang1))
);progn
);if
);or22
)
);cond2
(t
(setq ang2 (- (angle p1 (cadr YH_mouse)) ang1))
(if (< ang2 0)(setq ang2 (+ ang2 (* 2 pi))))
(cond
((and (> ang2 0 ) (< ang2 (/ pi 2)))
(vla-put-Rotation obj ang1)
(vla-put-insertionpoint obj (vlax-3d-point p2))
)
((and (> ang2 (/ pi 2) ) (< ang2 pi))
(vla-put-Rotation obj (- ang1 pi))
(vla-put-insertionpoint obj (vlax-3d-point p2))
)
((and (> ang2 pi ) (< ang2(* 3 (/ pi 2))))
(vla-put-Rotation obj (- ang1 pi))
(vla-put-insertionpoint obj (vlax-3d-point p3))
)
((and (> ang2 (* 3 (/ pi 2))) (< ang2(* pi 2)))
(vla-put-Rotation obj ang1)
(vla-put-insertionpoint obj (vlax-3d-point p3))
)
)
);t
);cond
));while
));while
(princ "\n完成")
);end
;;;--------箭头线----------
(defun c:jt (/ olderrtxt pt pt1 pt2 pt3 i ku k1)
(setq olderr*error*
*error* at_err
)
(setq oss (getvar "osmode"))
(PROMPT"\n标注内容: 1 上;2 下")
(WHILE(NOT(MEMBER(SETQ A(LAST(GRREAD)))'(49 50))))
(SETQ TXT(COND((= A 49)"上")((= A 50)"下")))
(setq pt0 (getpoint "\nPick point:"))
(if (setq pt1 pt0)
(progn (setq i 0)
(while (setq pt2 (getpoint pt1 "\nPick point:"))
(setq ku (angle pt1 pt2))
(setq k1 (+ ku pi))
(setq pt (polar pt1 k1 300))
(setvar "osmode" 0)
(setVar "OrthoMode" 1)
(if (= i 0)
(command "._text" "j" "mc" pt 350 0 txt)
(command "Donut" "0" "100" pt0 "" );画箭头线起点圆点
)
(command "line" pt1 pt2 "")
(command "")
(setq pt1 pt2
i (1+ i)
)
)
(setq pt3 (polar pt1 k1 300))
(command "Pline" pt1 "W" "0" "60" pt3 "")
)
)
(setq *error* olderr)
(setvar "osmode" oss)
(princ)
)
页:
[1]