序号生成------------苦闷中

linshiyin2

自贡黄明儒 发表于 2014-2-28 14:14
在未装PCCAD的机器上，无法修改这些序号。

那当然，自己独立的格式，包括自己写的也是啊，需要特殊的记号才能集体操作，比如增加、删除。

zhongzi-66

序号标注功能的基本需求：
1.支持各种序号形式，如引线、圆圈等
2.可以标注单个或多个序号
3.序号生成的同时，明细自动生成
4.序号与明细双向关联
5.增加或删除一个序号，其他的序号自动向后或向前移动，如删除4,后面的序号5自动变成序号4
……

zhongzi-66

用lisp实现起来比较难呢，建议大家直接选用尧创机械CAD，除上述基础的序号功能以外，还可以：
支持定制符合机械、纺织、汽车等行业标准的序号标注样式和产品明细表格式。
序号标注能够自动提取出库标准件的明细信息；
独创的明细信息记忆功能，成倍的提高了明细表填写的效率。
序号标注作为一个独立的实体，可以直接双击编辑修改；
支持水平或垂直对齐；
支持按顺时针或逆时针方向重新编排序号。
明细自动生成，可分栏排放，
可以将明细表输出为Excel格式文件
……

s678z

下面这个程序即显引线标注的序号字体宽度因子总是1，做出的字体太大，要求序号字体改成随cad文字样式-宽度因子设置的数字，而且可以取消(setq etxt(getvar "textstyle"))这句程序，该如何修改？
(defun eq_err(s)
(if (/= s "*取消*")
(if (or (= pt1 nil)(= pt2 nil)(= text0 nil))
(princ)(mapcar 'princ (LIST "\n结束编号:" rtext0) )))
(command "_.undo" "e")
(setvar "cmdecho" 1 )
(prin1)
)

(defun c:nn ( )
(setq *error* eq_err)
(setq sc (getvar "dimscale"))
(setq etxt(getvar "textstyle"))
(setvar "cmdecho" 0)
(command "_.undo" "be")
(if (= texthign nil)(setq texthign 5.0))
(mapcar 'princ (list "\n指定第一点或[设置字高(c)]<" texthign ">:"))
(initget 1 "C c")
(setvar "OSMODE" 675)
(setq pt0 (getpoint     ))
(while (or (= pt0 "c")(= pt0 "C"))
(initget 1)
(setq texthign (getreal "\n新字高:"))
(mapcar 'princ (list "\n指定第一点或[设置字高(c)]<" texthign ">:"))
(initget 1 "C c")
(setq pt0 (getpoint ))
)
(initget 1 )
(setq pt1 (getpoint pt0 "\n指定第二点:"))

(setq ozpx (car pt0) ozpy (cadr pt0))
(setq czpx (car pt1) czpy (cadr pt1))

(if (> czpx ozpx)
(progn
(setq pt2 (polar pt1 0 (* sc 7)))
(setq txp (mapcar '+ pt1 (list (* sc 3.5) (* sc 3.5) 0))))
(progn
(setq pt2 (polar pt1 pi (* sc 7)))
(setq txp (mapcar '+ pt1 (list (* sc -3.5) (* sc 3.5) 0))))
)

(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2)  (cons 10 pt0) (cons 10 pt1) (cons 10 pt2)))


(command "dimoverride"   "dimscale" sc ""  (entlast) "")
(if (= rtext0 nil)(setq rtext0 "0"))
(mapcar 'princ (list "\n起始编号:<" (1+ (atoi rtext0)) ">"))
(setq text0 (getstring ""))
(if (= text0 "")(progn (setq text0 (rtos(1+ (atoi rtext0))))(princ (1+ (atoi rtext0)))))
(entmake (list '(0 . "TEXT") (cons 1 text0) (cons 7 etxt) (cons 10 pt2)(cons 11 txp) (cons 40 (* SC texthign))(cons 71 0)(cons 72 4)))

(setq dti (grread T 15 2))
(setq cd  (car dti))
(setq dpt (cadr dti))
(setq dpx (car dpt) dpy (cadr dpt))
(setq s-x (abs (- dpx czpx)))
(setq s-y (abs (- dpy czpy)))
(setq plist (ssadd))
(setq rtt0 0)

(while (/= cd 3)
(if (> dpx czpx)
(setq eqdirct "right")(setq eqdirct "left"))

(cond
   (
    (> s-x s-y) (cond( (and (> dpx czpx)(> czpx ozpx)) (rtleader))
                     ( (and (< dpx czpx)(< czpx ozpx)) (ltleader)) )   ;;;;cond1
   )
   (
    (< s-x s-y) (cond( (> dpy czpy) (upleader))
                     ( (< dpy czpy) (dnleader)) )   ;;;;cond1
   )      ;;;;;;;;;cond2
)         ;;;;;;;;;cond

(setq dti (grread T 15 2))
(setq cd (car dti))
(setq dpt (cadr dti))
(setq dpx (car dpt) dpy (cadr dpt))
(setq s-x (abs (- dpx czpx)))
(setq s-y (abs (- dpy czpy)))
(setq rtt0 rtt)

)           ;;;end-while
(command "_.undo" "e")
(setvar "cmdecho" 1)
(mapcar 'princ (LIST "\n结束编号:" rtext0) )
(prin1)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun rtleader ( )
(setq ct 0)
(setq rtt (atoi (rtos (/ s-x (* sc 9)) 2 2) ))
(if (> rtt 20)(setq rtt 20))
(if (/= (- rtt rtt0) 0)
(progn
(if (/= (sslength plist) 0)(command "_.erase" plist ""))
(repeat  rtt

(setq xpt1 (polar pt2 0 (* ct 9 sc)))
(setq xpt2 (polar xpt1 (/ (* 5 pi) 3) (* sc 2) ))
(setq xpt3 (polar xpt2 (/ pi 3) (* sc 2)))
(setq xpt4 (polar xpt3 0 (*  7 sc)))
(setq rtxp (mapcar '+ xpt3 (list (* sc 3.5) (* sc 3.5) 0)))
(setq rtext0 (rtos (+ 1 ct (atoi text0))))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 3)
(cons 10 xpt4) (cons 10 xpt3)(cons 10 xpt2)(cons 10 xpt1)
))         ;;;;;;;;;;;entmake

(setq plist (ssadd (entlast) plist))
(entmake (list '(0 . "TEXT") (cons 1 rtext0)(cons 7 etxt) (cons 10 xpt3)(cons 11 rtxp) (cons 40 (* SC texthign))(cons 71 0)(cons 72 4)))
(setq plist (ssadd (entlast) plist))
(setq ct(1+ ct))
)))
(PRIN1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ltleader ( )
(setq ct 0)
(setq rtt (atoi (rtos (/ s-x (* sc 9)) 2 2) ))
(if (> rtt 20)(setq rtt 20))
(if (/= (- rtt rtt0) 0)
(progn
(if (/= (sslength plist) 0)(command "_.erase" plist ""))
(repeat  rtt
(= eqdirct "left")
(setq xpt1 (polar pt2 pi (* ct 9 sc)))
(setq xpt2 (polar xpt1 (/ (* 4 pi) 3) (* sc 2) ))
(setq xpt3 (polar xpt2 (/ (* 2 pi) 3) (* sc 2)))
(setq xpt4 (polar xpt3 pi (*  7 sc)))
(setq rtxp (mapcar '+ xpt3 (list (* sc -3.5) (* sc 3.5) 0)))
(setq rtext0 (rtos (+ 1 ct (atoi text0))))

(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 3)
(cons 10 xpt4) (cons 10 xpt3)(cons 10 xpt2)(cons 10 xpt1)
))    ;;;;;;;;;;;entmake

(setq plist (ssadd (entlast) plist))
(entmake (list '(0 . "TEXT") (cons 1 rtext0)(cons 7 etxt) (cons 10 xpt3)(cons 11 rtxp) (cons 40 (* SC texthign))(cons 71 0)(cons 72 4)))
(setq plist (ssadd (entlast) plist))
(setq ct(1+ ct))
)))
(PRIN1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upleader ( )
(setq ct 0)
(setq rtt (atoi (rtos (/ s-y (* sc 7)) 2 2) ))
(if (> rtt 20)(setq rtt 20))
(if (/= (- rtt rtt0) 0)
(progn
(if (/= (sslength plist) 0)(command "_.erase" plist ""))
(repeat  rtt

(cond
((> czpx ozpx )
(progn
(setq ypt1 (polar pt1  (/ pi 2) (* ct 7 sc)))
(setq ypt2 (polar ypt1 (/ pi 2) (* sc 7) ))
(setq ypt3 (polar ypt2 0 (* sc 7)))
(setq rtyp (mapcar '+ ypt2 (list (* sc 3.5) (* sc 3.5) 0)))
))
((< czpx ozpx)
(progn
(setq ypt1 (polar pt1  (/ pi 2) (* ct 7 sc)))
(setq ypt2 (polar ypt1 (/ pi 2) (* sc 7) ))
(setq ypt3 (polar ypt2 pi (* sc 7)))
(setq rtyp (mapcar '+ ypt2 (list (* sc -3.5) (* sc 3.5) 0)))
))
)

(setq rtext0 (rtos (+ 1 ct (atoi text0))))

(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2)  
(cons 10 ypt3)(cons 10 ypt2)(cons 10 ypt1)
))

(setq plist (ssadd (entlast) plist))
(entmake (list '(0 . "TEXT") (cons 1 rtext0)(cons 7 etxt) (cons 10 ypt2)(cons 11 rtyp) (cons 40 (* SC texthign))(cons 71 0)(cons 72 4)))
(setq plist (ssadd (entlast) plist))
(setq ct(1+ ct))
)))
(PRIN1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dnleader ( )
(setq ct 0)
(setq rtt (atoi (rtos (/ s-y (* sc 7)) 2 2) ))
(if (> rtt 20)(setq rtt 20))
(if (/= (- rtt rtt0) 0)
(progn
(if (/= (sslength plist) 0)(command "_.erase" plist ""))
(repeat  rtt
(cond
((> czpx ozpx)
(progn
(setq ypt1 (polar pt1  (* pi 1.5) (* ct 7 sc)))
(setq ypt2 (polar ypt1 (* pi 1.5) (* sc 7) ))
(setq ypt3 (polar ypt2 0 (* sc 7)))
(setq rtyp (mapcar '+ ypt2 (list (* sc 3.5) (* sc 3.5) 0)))
))
((< czpx ozpx)
(progn
(setq ypt1 (polar pt1  (* pi 1.5) (* ct 7 sc)))
(setq ypt2 (polar ypt1 (* pi 1.5) (* sc 7) ))
(setq ypt3 (polar ypt2 pi (* sc 7)))
(setq rtyp (mapcar '+ ypt2 (list (* sc -3.5) (* sc 3.5) 0)))
))
)

(setq rtext0 (rtos (+ 1 ct (atoi text0))))

(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2)  
(cons 10 ypt3)(cons 10 ypt2)(cons 10 ypt1)
))

(setq plist (ssadd (entlast) plist))
(entmake (list '(0 . "TEXT") (cons 1 rtext0)(cons 7 etxt) (cons 10 ypt2)(cons 11 rtyp) (cons 40 (* SC texthign))(cons 71 0)(cons 72 4)))
(setq plist (ssadd (entlast) plist))
(setq ct(1+ ct))
)))
(PRIN1))
(princ "\nThe program is made by Cyu")

(prin1)


下面这个程序序号数字宽度因子随cad文字样式-宽度因子设置的数字而变，但不能标注多个序号，供参考
(defun c:n (/ p1 p2 p3 txt)
(setq sc (getvar "dimscale"))
(setq txt (getstring "\nNumber: "))
(while (and (setvar "OSMODE" 0)
            (setq p1 (getpoint "\nInput P1: "))
            (setvar "OSMODE" 512)
            (setq p2 (getpoint p1 "\nInput P2: "))
           (setvar "OSMODE" 0)
           (setq p3 (getpoint p2 "\nInput P3: ")))
(setq angle1 (angle p2 p3))
  (if (< (/ pi 2) angle1 (* 1.5 pi)) (progn
   (command "pline" p1 p2 (polar p2 pi (* 7 sc )) "")
   (command "text" "j" "bc" (polar p2 2.737 (* 3.5 sc )) (* 5 sc ) 0 txt "")
  )
(progn
   (command "pline" p1 p2 (polar p2 0 (* 7 sc )) "")
  (command "text" "j" "bc" (polar p2 0.4 (* 3.5 sc )) (* 5 sc ) 0 txt "")
  ))
  (command "change" "l" "" "p" "la" "文字标注层" "")
  (setq txt (itoa (1+ (atoi txt))))
)
(princ)
(setvar "osmode" 167)
)