2点画Leader及批量修改Leader

waterchen · 发表于 2015-9-4 12:15:42

本帖最后由 waterchen 于 2015-9-4 13:37 编辑

由于工作中经常要画或者修改Leader,要点3个点才能画1个Leader,修改就更麻烦了,所以就写了这个小程序.功能很简单,点2个点按设定的角度画Leader，或者按设定的角度修改有3个点的Leader.
  Angle:       设定角度；
  Inplaceof：用当前的Dimension style,当前设定的角度,重新画一次所选择的Leader;
  Select:    用当前设定的角度修改所选择的Leader(要有3个点的才成哦);
  From point:输入2个点画Leader.
  这是初学写的，没什么技术含量，高手就顠过吧。同时源码都给出来了，如有什么不好的地方，或者有不同的喜好，又或者有想改进的地方,请各自修改吧。

(defun c:qt (/ oldang ang1 ang2 ang3 cc ent ent1 entla ent_data ent_data1 ent_data_n ent_pr hh input_type input_type1
i j pt_data pt1 pt2 pt3 pt4 pt3_dxf xpt1 xpt3 ypt1 ypt3 ss ss_lth ssla temp)
(defun *error* (msg)
(if (/= msg "Function cancelled") ; If an error (such as CTRL-C) occurs
(princ (strcat "\nError: " msg)) ; while this command is active...
)
(setvar "CMDECHO" 1)
(setvar "osmode" os)
(setq *error* olderr) ; Restore old *error* handler
(princ)
)
(setq olderr *error*)
(if (null oldang) (setq oldang 60.0))
(setq os (getvar "osmode"))
(setvar "CMDECHO" 0)
(initget (+ 1 128) "Angle Inplaceof Select")
(setq input_type (getpoint "\nAngle/Inplaceof/Select/<From point>:"))
(cond ((= input_type "Angle")
(prompt "\nSetting Leader Angle.")
(setq ang1 nil)
(while (/= 'REAL (type ang1))
(initget (+ 2 4 128))
(setq ang1 (getreal (strcat "\nAngle of leader <" (rtos oldang 2 2) ">: ")))
(if (null ang1) (setq ang1 (* (/ oldang 180) PI)))
(if (= 'STR (type ang1)) (setq ang1 (eval (read ang1))))
(if (/= 'REAL (type ang1)) (princ "\nRequires numeric value."))
)
;(setq ang1 (* (/ ang1 180) PI))
(setq oldang ang1)
(initget (+ 1 128) "Inplaceof Select")
(setq input_type1 (getpoint "\nInplaceof/Select/<From point>:"))
(cond ((= input_type1 "Inplaceof") (setq ang1 (* (/ oldang 180) PI)) (Inplaceof_leader_drawing))
((= input_type1 "Select") (setq ang1 (* (/ oldang 180) PI)) (select_leader_drawing))
((= 'LIST (type input_type1))
(setq pt1 input_type1) (setq ang1 (* (/ oldang 180) PI)) (leader_drawing))
)
)
((= input_type "Inplaceof") (setq ang1 (* (/ oldang 180) PI)) (Inplaceof_leader_drawing))
((= input_type "Select") (setq ang1 (* (/ oldang 180) PI)) (select_leader_drawing))
((= 'LIST (type input_type)) (setq ang1 (* (/ oldang 180) PI))
(setq pt1 input_type)
(leader_drawing)
)
)
(setvar "osmode" os)
(setvar "CMDECHO" 1)
(setq *error* olderr)
(princ)
)
;;; --------------------------- sub Program ---------------------------------;
(defun select_leader_drawing ()
(prompt "\nChange of Select Leader.")
(SETQ SS (ssget '((0 . "LEADER"))))
;(if (= ang1 0) (setq ang1 (/ PI 3)))
(setq ang2 (sin ang1))
(setq j 0)
(setq ss_lth 0)
(setq SS_lth (sslength ss))
(command "_.undo" "group")
(WHILE (< j SS_lth)
(setq i 0)
(setq pt1 nil)
(setq pt2 nil)
(setq pt3 nil)
(setq ent (ssname ss j))
(setq ent_data (entget ent))
(setq ent_pr ent_data)
(while (/= ent_pr nil)
(setq temp (car ent_pr))
(if (= (car temp) 10)
(if (/= pt1 nil)
(if (/= pt2 nil)
(setq pt3 (cdr temp))
(progn (setq pt2 (cdr temp)) (setq pt2_nth i))
)
(setq pt1 (cdr temp))
)
)
(setq ent_pr (cdr ent_pr))
(setq i (+ i 1))
)
(if (/= pt3 nil)
(progn
(setq ang3 (angle pt1 pt3))
(setq xpt1 (car pt1))
(setq ypt1 (car (cdr pt1)))
(setq xpt3 (car pt3))
(setq ypt3 (car (cdr pt3)))
(setq hh (abs (- ypt3 ypt1)))
(setq cc (/ hh ang2))
(if (< ang3 (* PI 0.5))
(setq pt2_n (polar pt1 ang1 cc)))
(if (and (> ang3 (* PI 0.5)) (< ang3 PI))
(setq pt2_n (polar pt1 (- PI ang1) cc)))
(if (and (> ang3 PI) (< ang3 (+ PI (* PI 0.5))))
(setq pt2_n (polar pt1 (+ PI ang1) cc)))
(if (and (> ang3 (+ PI (* PI 0.5))) (< ang3 (* PI 2)))
(setq pt2_n (polar pt1 (- (* PI 2) ang1) cc)))
(setq pt_data (cons 10 pt2_n))
(setq ent_data_n (subst pt_data (nth pt2_nth ent_data) ent_data))
(entmod ent_data_n)
)
)
(SETQ j (1+ j))
)
(command "_.UNDO" "END")
)
;;;==============================leader_drawing=============================
(defun leader_drawing ()
(prompt "\nDrawing Leader.")
(initget (+ 32 128))
(setq pt3 (getpoint pt1 "\nInput leader sencond point:"))
(setvar "osmode" 0)
;(if (= ang1 0) (setq ang1 (/ PI 3)))
(setq ang2 (sin ang1))
(setq ang3 (angle pt1 pt3))
(setq ssla nil)
(setq xpt1 (car pt1))
(setq ypt1 (car (cdr pt1)))
(setq xpt3 (car pt3))
(setq ypt3 (car (cdr pt3)))
(setq hh (abs (- ypt3 ypt1)))
(setq cc (/ hh ang2))
(if (< ang3 (* PI 0.5))
(progn (setq pt2 (polar pt1 ang1 cc))
(setq pt4 (polar pt3 0 100))
(setq ssla (ssget "f" (list pt3 pt4)))
))
(if (and (> ang3 (* PI 0.5)) (< ang3 PI))
(progn (setq pt2 (polar pt1 (- PI ang1) cc))
(setq pt4 (polar pt3 pi 100))
(setq ssla (ssget "f" (list pt3 pt4)))
))
(if (and (> ang3 PI) (< ang3 (+ PI (* PI 0.5))))
(progn (setq pt2 (polar pt1 (+ PI ang1) cc))
(setq pt4 (polar pt3 pi 100))
(setq ssla (ssget "f" (list pt3 pt4)))
))
(if (and (> ang3 (+ PI (* PI 0.5))) (< ang3 (* PI 2)))
(progn (setq pt2 (polar pt1 (- (* PI 2) ang1) cc))
(setq pt4 (polar pt3 0 100))
(setq ssla (ssget "f" (list pt3 pt4)))
))
(command "leader" pt1 pt2 pt3 "Annotation" "" "NONE")
(if (/= ssla nil)
(progn (setq ent1 (entlast))
(setq ent (ssname ssla 0))
(setq ent_data1 (cdr (entget ent)))
(setq entla (cdr (assoc '8 ent_data1)))
(command "chprop" ent1 "" "la" entla "")
))
)
;;;==============================Inplaceof_leader_drawing=============================
(defun Inplaceof_leader_drawing ()
(prompt "\nInplace of Select Leader.")
(setvar "osmode" 0)
(SETQ SS (ssget '((0 . "LEADER"))))
;(if (= ang1 0) (setq ang1 (/ PI 3)))
(setq ang2 (sin ang1))
(setq j 0)
(setq ss_lth 0)
(setq SS_lth (sslength ss))
(WHILE (< j SS_lth)
(setq i 0)
(setq pt1 nil)
(setq pt2 nil)
(setq pt3 nil)
(setq ent (ssname ss j))
(setq ent_data (entget ent))
(setq la (cdr (assoc 8 ent_data)))
(setvar "clayer" la)
(setq ent_pr ent_data)
(while (/= ent_pr nil)
(setq temp (car ent_pr))
(if (= (car temp) 10)
(if (/= pt1 nil)
(if (/= pt2 nil)
(setq pt3 (cdr temp))
(progn (setq pt2 (cdr temp)) (setq pt2_nth i))
)
(setq pt1 (cdr temp))
)
)
(setq ent_pr (cdr ent_pr))
(setq i (+ i 1))
)
(if (/= pt3 nil)
(progn
(setq ang3 (angle pt1 pt3))
(setq xpt1 (car pt1))
(setq ypt1 (car (cdr pt1)))
(setq xpt3 (car pt3))
(setq ypt3 (car (cdr pt3)))
(setq hh (abs (- ypt3 ypt1)))
(setq cc (/ hh ang2))
(if (< ang3 (* PI 0.5))
(setq pt2_n (polar pt1 ang1 cc)))
(if (and (> ang3 (* PI 0.5)) (< ang3 PI))
(setq pt2_n (polar pt1 (- PI ang1) cc)))
(if (and (> ang3 PI) (< ang3 (+ PI (* PI 0.5))))
(setq pt2_n (polar pt1 (+ PI ang1) cc)))
(if (and (> ang3 (+ PI (* PI 0.5))) (< ang3 (* PI 2)))
(setq pt2_n (polar pt1 (- (* PI 2) ang1) cc)))
(command "leader" pt1 pt2_n pt3 "Annotation" "" "NONE")
(entdel ent)
)
)
(SETQ j (1+ j))
)
(command "_.UNDO" "END")
)
(princ)

(defun c:qt (/ oldang ang1 ang2 ang3 cc ent ent1 entla ent_data ent_data1 ent_data_n ent_pr hh input_type input_type1 
       i j pt_data pt1 pt2 pt3 pt4 pt3_dxf xpt1 xpt3 ypt1 ypt3 ss ss_lth ssla temp) 
  (defun *error* (msg) 
    (if (/=  msg "Function cancelled")     ; If an error (such as CTRL-C) occurs 
      (princ (strcat "\nError: " msg))    ; while this command is active... 
      ) 
    (setvar "CMDECHO" 1) 
    (setvar "osmode" os) 
    (setq *error* olderr)               ; Restore old *error* handler 
    (princ) 
    ) 
  (setq olderr *error*) 
  (if (null oldang) (setq oldang 60.0)) 
  (setq os (getvar "osmode")) 
  (setvar "CMDECHO" 0) 
  (initget (+ 1 128) "Angle Inplaceof Select") 
  (setq input_type (getpoint "\nAngle/Inplaceof/Select/<From point>:")) 
  (cond ((= input_type "Angle") 
   (prompt "\nSetting Leader Angle.") 
   (setq ang1 nil) 
   (while (/= 'REAL (type ang1)) 
     (initget (+ 2 4 128)) 
     (setq ang1 (getreal (strcat "\nAngle of leader <" (rtos oldang 2 2) ">: "))) 
     (if (null ang1) (setq ang1 (* (/ oldang 180) PI))) 
     (if (= 'STR (type ang1)) (setq ang1 (eval (read ang1)))) 
     (if (/= 'REAL (type ang1)) (princ "\nRequires numeric value.")) 
     ) 
   ;(setq ang1 (* (/ ang1 180) PI)) 
   (setq oldang ang1) 
    
   (initget (+ 1 128) "Inplaceof Select") 
   (setq input_type1 (getpoint "\nInplaceof/Select/<From point>:")) 
   (cond ((= input_type1 "Inplaceof") (setq ang1 (* (/ oldang 180) PI)) (Inplaceof_leader_drawing)) 
         ((= input_type1 "Select") (setq ang1 (* (/ oldang 180) PI)) (select_leader_drawing)) 
         ((= 'LIST (type input_type1)) 
    (setq pt1 input_type1) (setq ang1 (* (/ oldang 180) PI)) (leader_drawing)) 
         ) 
   ) 
  ((= input_type "Inplaceof") (setq ang1 (* (/ oldang 180) PI)) (Inplaceof_leader_drawing)) 
  ((= input_type "Select") (setq ang1 (* (/ oldang 180) PI)) (select_leader_drawing)) 
  ((= 'LIST (type input_type)) (setq ang1 (* (/ oldang 180) PI)) 
   (setq pt1 input_type) 
   (leader_drawing) 
   ) 
  ) 
  (setvar "osmode" os) 
  (setvar "CMDECHO" 1) 
  (setq *error* olderr) 
  (princ) 
  ) 
 
;;; --------------------------- sub Program ---------------------------------; 
(defun select_leader_drawing () 
  (prompt "\nChange of Select Leader.") 
  (SETQ SS (ssget '((0 . "LEADER")))) 
  ;(if (= ang1 0) (setq ang1 (/ PI 3))) 
  (setq ang2 (sin ang1)) 
  (setq j 0) 
  (setq ss_lth 0) 
  (setq SS_lth (sslength ss)) 
  (command "_.undo" "group") 
  (WHILE (< j SS_lth) 
    (setq i 0) 
    (setq pt1 nil) 
    (setq pt2 nil) 
    (setq pt3 nil) 
    (setq ent (ssname ss j)) 
    (setq ent_data (entget ent)) 
    (setq ent_pr ent_data) 
    (while (/= ent_pr nil) 
      (setq temp (car ent_pr)) 
      (if (= (car temp) 10) 
  (if (/= pt1 nil) 
    (if (/= pt2 nil) 
      (setq pt3 (cdr temp)) 
      (progn (setq pt2 (cdr temp)) (setq pt2_nth i)) 
      ) 
    (setq pt1 (cdr temp)) 
    ) 
   
  ) 
      (setq ent_pr (cdr ent_pr)) 
      (setq i (+ i 1)) 
      ) 
    
    (if (/= pt3 nil) 
      (progn 
  (setq ang3 (angle pt1 pt3)) 
  (setq xpt1 (car pt1)) 
  (setq ypt1 (car (cdr pt1))) 
  (setq xpt3 (car pt3)) 
  (setq ypt3 (car (cdr pt3))) 
  (setq hh (abs (- ypt3 ypt1))) 
  (setq cc (/ hh ang2)) 
  (if (< ang3 (* PI 0.5)) 
    (setq pt2_n (polar pt1 ang1 cc))) 
  (if (and (> ang3 (* PI 0.5)) (< ang3 PI)) 
    (setq pt2_n (polar pt1 (- PI ang1) cc))) 
  (if (and (> ang3 PI) (< ang3 (+ PI (* PI 0.5)))) 
    (setq pt2_n (polar pt1 (+ PI ang1) cc))) 
  (if (and (> ang3 (+ PI (* PI 0.5))) (< ang3 (* PI 2))) 
    (setq pt2_n (polar pt1 (- (* PI 2) ang1) cc))) 
  (setq pt_data (cons 10 pt2_n)) 
  (setq ent_data_n (subst pt_data (nth pt2_nth ent_data) ent_data)) 
  (entmod ent_data_n) 
  ) 
      ) 
    (SETQ j (1+ j)) 
    ) 
  (command "_.UNDO" "END") 
  ) 
 
;;;==============================leader_drawing============================= 
(defun leader_drawing () 
    (prompt "\nDrawing Leader.") 
    (initget (+ 32 128)) 
    (setq pt3 (getpoint pt1 "\nInput leader sencond point:")) 
    (setvar "osmode" 0) 
    ;(if (= ang1 0) (setq ang1 (/ PI 3))) 
  (setq ang2 (sin ang1)) 
  (setq ang3 (angle pt1 pt3)) 
    (setq ssla nil) 
    (setq xpt1 (car pt1)) 
    (setq ypt1 (car (cdr pt1))) 
  (setq xpt3 (car pt3)) 
    (setq ypt3 (car (cdr pt3))) 
  (setq hh (abs (- ypt3 ypt1))) 
  (setq cc (/ hh ang2)) 
  (if (< ang3 (* PI 0.5)) 
      (progn  (setq pt2 (polar pt1 ang1 cc)) 
        (setq pt4 (polar pt3 0 100)) 
        (setq ssla (ssget "f" (list pt3 pt4))) 
    )) 
    (if (and (> ang3 (* PI 0.5)) (< ang3 PI)) 
    (progn  (setq pt2 (polar pt1 (- PI ang1) cc)) 
        (setq pt4 (polar pt3 pi 100)) 
        (setq ssla (ssget "f" (list pt3 pt4))) 
    )) 
    (if (and (> ang3 PI) (< ang3 (+ PI (* PI 0.5)))) 
    (progn  (setq pt2 (polar pt1 (+ PI ang1) cc)) 
        (setq pt4 (polar pt3 pi 100)) 
        (setq ssla (ssget "f" (list pt3 pt4))) 
    )) 
    (if (and (> ang3 (+ PI (* PI 0.5))) (< ang3 (* PI 2))) 
    (progn  (setq pt2 (polar pt1 (- (* PI 2) ang1) cc)) 
        (setq pt4 (polar pt3 0 100)) 
        (setq ssla (ssget "f" (list pt3 pt4))) 
    )) 
    (command "leader" pt1 pt2 pt3 "Annotation" "" "NONE") 
    (if (/= ssla nil) 
      (progn  (setq ent1 (entlast)) 
        (setq ent (ssname ssla 0)) 
        (setq ent_data1 (cdr (entget ent))) 
        (setq entla (cdr (assoc '8 ent_data1))) 
        (command "chprop" ent1 "" "la" entla "") 
     )) 
) 
 
;;;==============================Inplaceof_leader_drawing============================= 
(defun Inplaceof_leader_drawing () 
  (prompt "\nInplace of Select Leader.") 
  (setvar "osmode" 0) 
  (SETQ SS (ssget '((0 . "LEADER")))) 
  ;(if (= ang1 0) (setq ang1 (/ PI 3))) 
  (setq ang2 (sin ang1)) 
  (setq j 0) 
  (setq ss_lth 0) 
  (setq SS_lth (sslength ss)) 
   
  (WHILE (< j SS_lth) 
    (setq i 0) 
    (setq pt1 nil) 
    (setq pt2 nil) 
    (setq pt3 nil) 
    (setq ent (ssname ss j)) 
    (setq ent_data (entget ent)) 
    (setq la (cdr (assoc 8 ent_data))) 
    (setvar "clayer" la) 
    (setq ent_pr ent_data) 
    (while (/= ent_pr nil) 
      (setq temp (car ent_pr)) 
      (if (= (car temp) 10) 
  (if (/= pt1 nil) 
    (if (/= pt2 nil) 
      (setq pt3 (cdr temp)) 
      (progn (setq pt2 (cdr temp)) (setq pt2_nth i)) 
      ) 
    (setq pt1 (cdr temp)) 
    ) 
   
  ) 
      (setq ent_pr (cdr ent_pr)) 
      (setq i (+ i 1)) 
      ) 
    
    (if (/= pt3 nil) 
      (progn 
  (setq ang3 (angle pt1 pt3)) 
  (setq xpt1 (car pt1)) 
  (setq ypt1 (car (cdr pt1))) 
  (setq xpt3 (car pt3)) 
  (setq ypt3 (car (cdr pt3))) 
  (setq hh (abs (- ypt3 ypt1))) 
  (setq cc (/ hh ang2)) 
  (if (< ang3 (* PI 0.5)) 
    (setq pt2_n (polar pt1 ang1 cc))) 
  (if (and (> ang3 (* PI 0.5)) (< ang3 PI)) 
    (setq pt2_n (polar pt1 (- PI ang1) cc))) 
  (if (and (> ang3 PI) (< ang3 (+ PI (* PI 0.5)))) 
    (setq pt2_n (polar pt1 (+ PI ang1) cc))) 
  (if (and (> ang3 (+ PI (* PI 0.5))) (< ang3 (* PI 2))) 
    (setq pt2_n (polar pt1 (- (* PI 2) ang1) cc))) 
  (command "leader" pt1 pt2_n pt3 "Annotation" "" "NONE") 
  (entdel ent) 
  ) 
      ) 
    (SETQ j (1+ j)) 
    ) 
  (command "_.UNDO" "END") 
  ) 
 
(princ)

yaokui25 · 发表于 2015-9-4 14:25:23

谢谢楼主分享

hbgsw · 发表于 2015-9-4 17:09:25

先收藏了。

yoyoho · 发表于 2015-9-4 18:24:52

感谢 waterchen 分享程序!

lucas_3333 · 发表于 2015-9-7 20:10:18

2点leader是很好! 但是代码这么长, 看看就望而却步了,[em0]

ynhh · 发表于 2015-9-11 10:42:34

感觉有点象QQ截图中的画箭头啊
感谢谢你的分享

账号		自动登录	找回密码
密码			注册

[源码] 2点画Leader及批量修改Leader

本帖子中包含更多资源