画剖切符号~

yangwenclever

求助这样的剖切符号怎么写。  步骤大概是 输入索引号，点击第一点，点击第二点，点击第三点，鼠标上下移动确定剖切方向，点击鼠标确实。

鱼与熊掌

(defun c:qqx (/ ang bli cir_x lst lst_dao2 lst_end pt pt1 pt2 pt3 pt4)
  (cxsta)
  (SETQ BLI (getvar "dimscale"))
  (prompt "画剖切符,by cx\n")
  (setq        pt1 (getpoint "剖切线第一个点,")
                pt2 (getpoint pt1 "剖切线第二个点.\n")
                ang (angle pt1 pt2)
                pt3 (polar pt1 (+ ang (/ pi 2)) (* 1 bli)) ;
                pt3 (polar pt3 ang (* 1 bli))
                pt4 (polar (polar pt2 (+ ang (/ pi 2)) (* 1 bli))
                        (+ pi ang)
                        (* 1 bli)
                )
  )
  (cx-line pt1 pt2)
  (ghs 4)
       
  (cx-pline (list pt3
                  pt4
                )
                0
  )
  (ghs 1)
  (cx-plkd (entlast) (* 0.3 bli))
  (command "pline" pt2)
  (setq lst nil)
  (setq lst (cons pt2 lst))
  (while (setq pt (getpoint pt2 "拉线,回车确定索引号位置.\n"))
    (command pt)
    (setq pt2 pt)
    (setq lst (cons pt lst))
  )
  (command "")                                ;结束画pl线
  (if (> (length lst) 1)
    (progn
      (ghs 4)
      (setq
                                lst_end         (xnth 0 lst)
                                lst_dao2 (xnth 1 lst)                ;倒2
                                ang         (angle lst_dao2 lst_end)
                                cir_x         (polar lst_end ang (* 5 BLI))
      )
      (cx-syh cir_x)
    )
  )
       
       
  (cxend)
)

鱼与熊掌

;子函数画索引号
(DEFUN cx-SYH (pt / bli)
  ;(setq pt (getpoint))
  (SETQ BLI (getvar "dimscale"))
  (CX-CIR PT (* BLI 5))
  (GHS 4)
  (CX-LINE (CX-A PT (* 5 BLI)) (CX-D PT (* 5 BLI)))
  (GHS 4)
  (CX-TEXT (CX-A (CX-W PT (* 1 BLI)) (* 1 BLI)) "1" (* 3 bli))
  (ghs 3)
  (cx-text (cx-s (cx-a pt (* 4 bli)) (* 3 bli))
                "P-03-01"
                (* 2 bli)
  ) ;_ 结束cx-text
  (ghs 3)
)

(defun ghs (clo /)
  (vla-put-Color (vlax-ename->vla-object (entlast)) clo)
)
;改PL线宽度
(defun cx-plkd (tuyuanm kd / ed)
  (setq ed (entget tuyuanm))
  (setq ed (subst (cons 40 kd) (assoc 40 ed) ed))
  (setq ed (subst (cons 41 kd) (assoc 41 ed) ed))
  (setq ed (subst (cons 43 kd) (assoc 43 ed) ed))
  (entmod ed)
)

(defun cx-cir (pt bj /)
  (entmakex
    (list
      '(0 . "circle")
      (cons 10 pt)
      (cons 40 bj)
    ) ;_ 结束list
  ) ;_ 结束entmakex
)

鱼与熊掌

提供大部分函数  (cxsta) (cxend)删掉.   

hao3ren

呵呵，还缺函数，CX-LINE 、CX-PLINE、CX-TEXT

鱼与熊掌

hao3ren 发表于 2014-12-13 16:32
呵呵，还缺函数，CX-LINE 、CX-PLINE、CX-TEXT

都是无聊的函数  自己补补就好咯     (cx-line p1 p2) (cx-line lst d70)

依然小小鸟

期待高手完善

1、2、3、三枪

下个工具箱吧！！！