[分享]：表格绘制，自由对齐命令，规划词典，甲级规划院

shuaier

表格绘制，自由对齐命令，规划词典，甲级规划院

amandy

怎么用啊

shuaier

打开CAD用APPLOAD命令加载*.LSP，之后用命令：BG（表格命令），DQ（对齐命令）就可以了。

xzw603818

表格好用,不错,对齐不好用

shuaier

一、将AUTOCAD背景设为透明
命令：wmfbkgnd
二、CAD打印时将字体打印为空心字,实心字
命令:textfill
输入命令→0(空心字),1(实心字)→确定

三、求质心
先将平面图形设成面域,然后输入命令massprop ,此命令也可用于三维立体的CAD图!

四、AUTO手绘命令
sketch
在使用该命令前,用SKPOLY命令可是手绘的线条在直线和多段线间切换.0为直线(多条首尾相连的直线),
1为多段线(一条线段)


下面附带一个坐标标注程序：
命令：pptext
lsp程序:
(vmon)
(defun c:ldist()
(setq olderr *error* *error* myerr)
(setq pm (getvar "OSMODE"))
(setvar "OSMODE" 33)
(initget 1 "Point Object")
(setq t (getkword "\nSelect Point or Object:"))
(setq t (strcase (substr t 1 1)))
(setq ld (getstring "\nLength or none:"))
(setq h (getvar "TEXTSIZE"))
(if (= t "P") (setq ob1 (getpoint "\nFirst point:")) (setq ob1 '(0 0)))
(while (/= nil ob1)
  (setvar "OSMODE" 33)
  (if (= t "P") (progn
    (setq p1 ob1)
    (setq p2 (getpoint "\nNext point:"))
    (setq ob1 p2))
   (setq ob1 (entsel "select line:")))
  (if (/= ob1 nil) (progn
    (if (= t "O") (progn
      (setq ob1 (entget (car ob1)))
      (setq p1 (cdr (assoc 10 ob1)))
      (setq p2 (cdr (assoc 11 ob1)))))
    (setq dist (distance p1 p2))
    (if (< (car p1) (car p2))
     (setq ang (angle p1 p2))
     (setq ang (angle p2 p1)))
    (setq angtext (/ (* ang 180.0) pi))
    (setvar "OSMODE" 1024)
    (setq pp (getpoint "\nText_position:"))
    (setq dist (rtos dist 2 2))
    (if (= (strcase (substr ld 1 1)) "L") (progn
      (setq p1 pp)
      (setq pp (polar pp ang (* h 2)))
      (setq p2 (polar pp ang (* (strlen dist) h 0.9)))
      (command "text" p1 h angtext "L=")
      (command "text" p2 h angtext "m")))
    (command "text" pp h angtext dist))))
(setvar "OSMODE" pm)
(prin1))

(defun c:rohi()
(setq olderr *error* *error* myerr)
(setq pm (getvar "OSMODE"))
(setq ld (getstring "\nLine or ():"))
(setq h (getvar "TEXTSIZE"))
(setq p1 (polar '(1 1) 0 1))
(while (/= nil p1)
  (setvar "OSMODE" 1)
  (setq p1 (getpoint "\nEnd_point:"))
  (setvar "OSMODE" 1024)
  (if (/= nil p1) (progn
    (setq p2 (getpoint "\nWay:"))
    (setq text (getstring "\nRoad_high:"))
    (if (= (strcase (substr ld 1 1)) "L") (progn
      (if (< (car p1) (car p2)) (setq ang 0) (setq ang pi))
      (setq p2 (polar p1 ang (* (+ (strlen text) 1) h 0.8)))
      (setq p3 (polar p1 (/ pi 2) (* h 1.5)))
      (setq p4 (polar p1 (* pi 1.5) (* h 1.5)))
      (if (< (car p1) (car p2))
       (setq p5 (polar p1 (* 0.2 pi) (* h 0.7)))
       (setq p5 (polar p2 (* 0.2 pi) (* h 0.7))))
      (command "line" p1 p2 "")
      (command "line" p3 p4 ""))
     (progn
      (if (< (car p1) (car p2))
       (setq p2 (polar p1 0 (* h 0.3)))
       (setq p2 (polar p1 pi (* (strlen text "( )") h 0.8))))
      (setq p2 (polar p2 (- (* pi 0.5)) (* h 0.5)))
      (setq p3 (polar p2 0 (* (strlen text " )") h 0.8)))
      (setq p5 (polar p2 0 (* h 0.8)))
      (command "text" p2 h 0 "(")
      (command "text" p3 h 0 ")")))
    (command "text" p5 h 0 text))))
(setvar "OSMODE" pm)
(prin1))

(defun c:pptext()
(setq olderr *error* *error* myerr)
(setq pm (getvar "OSMODE"))
(setq h (getvar "TEXTSIZE"))
(setq p0 (polar '(1 1) 0 1))
(while (/= nil p0)
  (setvar "OSMODE" 33)
  (setq p0 (getpoint "\nInter_point:"))
  (setvar "OSMODE" 1024)
  (if (/= nil p0) (progn
    (setq pp (getpoint "\nText_position:"))
    (if (< (car pp) (car p0)) (progn
      (setq pp1 pp)
      (setq pp (polar pp pi (* (+ (strlen (rtos (car p0) 2 2)) 2) h 0.8))))
     (setq pp1 (polar pp 0 (* (+ (strlen (rtos (car p0) 2 2)) 2) h 0.8))))
    (setq p1 (polar pp (* pi 0.2) (* h 0.7)))
    (setq p2 (polar (polar pp (- (* pi 0.2)) (* h 0.7)) (* pi 1.5) h))
    (command "text" p1 h 0 "X")
    (command "text" p2 h 0 "Y")
    (setq p1 (polar p1 0 (* h 0.9)))
    (setq p2 (polar p2 0 (* h 0.9)))
    (command "text" p1 h 0 (rtos (nth 1 p0) 2 2))
    (command "text" p2 h 0 (rtos (car p0) 2 2))
    (if (< (car pp) (car p0))
     (command "line" p0 pp1 pp "")
     (command "line" p0 pp pp1 "")))))
(setvar "OSMODE" pm)
(prin1))

(defun c:wtb()
(setq olderr *error* *error* myerr)
(setq pm (getvar "OSMODE"))
(setq h (getvar "TEXTSIZE"))
(setq p0 (polar '(1 1) 0 1))
(while (/= nil p0)
  (setvar "OSMODE" 4)
  (setq p0 (getpoint "\nInter_point:"))
  (setvar "OSMODE" 1024)
  (if (/= nil p0) (progn
    (setq p1 (getpoint "\nBox position:"))
    (if (< (car p0) (car p1)) (setq an 0) (setq an pi))
    (setq p2 (polar p1 an (* h 3.5)))
    (if (< (nth 1 p0) (nth 1 p1))
     (setq ang (* pi 0.5))
     (setq ang (* pi 1.5)))
    (setq p11 (polar p1 ang (* h 1.1)))
    (setq p21 (polar p2 ang (* h 1.1)))
    (setq p12 (polar p11 ang (* h 1.1)))
    (setq p22 (polar p21 ang (* h 1.1)))
    (setq p13 (polar p12 ang (* h 1.1)))
    (setq p23 (polar p22 ang (* h 1.1)))
    (command "line" p0 p1 p2 p23 p13 p1 "")
    (command "line" p11 p21 "")
    (command "line" p12 p22 "")
   )
  )
)
(setvar "OSMODE" pm)
(prin1))

(defun c:ar()
(setq olderr *error* *error* myerr)
(setq h (getvar "TEXTSIZE"))
(setvar "OSMODE" 1024)
(setq ob1 (ssget))
(setq p1 (entget (ssname ob1 0)))
(setq pp (assoc 11 p1))
(if (> (sslength ob1) 1) (command "pedit" ob1 "y" "j" ob1 "" "x"))
(setq ob1 (entsel))
(setq pp (cadr ob1))
(setq p1 (getpoint "\nText_position:"))
(command "area" "e" pp)
(setq an (getvar "AREA"))
(command "text" p1 h 0 (rtos an 2 2))
(command "explode" pp)
(prin1))

(defun c:ct()
(setq olderr *error* *error* myerr)
(setq ob1 (ssget))
(initget 1 "Highe Width Style")
(setq t (getkword "\nchange Highe/Width/Style:"))
(cond ((= (strcase (substr t 1 1)) "H") (setq h (getdist "\nNew text size:")))
       ((= (strcase (substr t 1 1)) "W") (setq h (getreal "\nNew text width:")))
       ((= (strcase (substr t 1 1)) "S") (progn
        (setq h (getstring "\New text style:"))
        (setq t1 (getstring "\nNew font file:"))
        (command "style" h t1 "0" "1" "0" "" ""))))
(setq pp 0)
(repeat (sslength ob1)
  (setq p1 (entget (ssname ob1 pp)))
  (setq pp (+ 1 pp))
  (setq an (assoc 0 p1))
  (if (= "TEXT" (cdr an))
   (progn
   (cond ((= (strcase (substr t 1 1)) "H") (setq pm (assoc 40 p1)))
         ((= (strcase (substr t 1 1)) "W") (setq pm (assoc 41 p1)))
         ((= (strcase (substr t 1 1)) "S") (setq pm (assoc 7 p1))))
    (setq p2 (cons (car pm) h))
    (setq p3 (subst p2 pm p1))
    (entmod p3))))
(prin1))

(defun c:ct1()
(setq olderr *error* *error* myerr)
(setq ob1 (ssget))
(setq pp 0)
(repeat (sslength ob1)
  (setq p1 (entget (ssname ob1 pp)))
  (setq pp (+ 1 pp))
  (setq an (assoc 0 p1))
  (if (= "TEXT" (cdr an))
   (progn
    (setq pm (assoc 1 p1))
    (setq h (cdr pm))
    (if (= (substr h (strlen h)) "-") (setq h (strcat "D" (substr h 1 (- (strlen h) 1)))))
    (setq js (strlen h) n 0)
    (while (> js 1)
     (if (= (substr h js 1) "-")
      (cond ((= n 0) (setq h (strcat (substr h 1 (- js 1)) " i=" (substr h (+ js 1))) n (+ n 1)))
            ((= n 1) (setq h (strcat (substr h 1 (- js 1)) " L=" (substr h (+ js 1))) n (+ n 1)))))
     (setq js (- js 1)))
    (if (= n 1) (setq h (strcat " L=" h)))
    (if (= n 2) (setq h (strcat "D" h)))
    (setq p2 (cons (car pm) h))
    (setq p3 (subst p2 pm p1))
    (entmod p3))))
(prin1))

(defun c:ct2()
(setq olderr *error* *error* myerr)
(setq ob1 (ssget))
(setq pp 0)
(repeat (sslength ob1)
  (setq p1 (entget (ssname ob1 pp)))
  (setq pp (+ 1 pp))
  (setq an (assoc 0 p1))
  (if (= "TEXT" (cdr an))
   (progn
    (setq pm (assoc 1 p1))
    (setq h (cdr pm))
    (if (= (substr h 1 1) "D") (setq h (strcat "DN" (substr h 2))))
    (setq p2 (cons (car pm) h))
    (setq p3 (subst p2 pm p1))
    (entmod p3))))
(prin1))

(defun c:pd()
(setq olderr *error* *error* myerr)
(setq h (getvar "TEXTSIZE"))
(setq p1 (entget (car (entsel))))
(setq p1 (atof (cdr (assoc 1 p1))))
(setq p2 (entget (car (entsel))))
(setq p2 (atof (cdr (assoc 1 p2))))
(setq pp (entget (car (entsel))))
(setq ang (cdr (assoc 50 pp)))
(setq pp (atof (cdr (assoc 1 pp))))
(if (> p1 p2) (setq p1 (* (/ (- p1 p2) pp) 100)) (setq p1 (* (/ (- p2 p1) pp) 100)))
(setq pp (getpoint "\nText_position:"))
(command "text" pp h (/ (* ang 180) pi) "i=")
(command "text" (polar pp ang (* h 1.8)) h (/ (* ang 180) pi) (rtos p1 2 2))
(prin1))

(defun c:pj()
(setq olderr *error* *error* myerr)
(setq h (getvar "TEXTSIZE"))
(setq ob1 (ssget) pp 0 ts0 0)
(repeat (sslength ob1)
  (setq p1 (entget (ssname ob1 pp)))
  (setq pp (+ 1 pp) an (assoc 0 p1))
  (if (= "TEXT" (cdr an)) (setq p1 (atof (cdr (assoc 1 p1))) ts0 (+ ts0 p1))))
(setq pp (getpoint "\nText_position:"))
(command "text" pp h 0 (rtos (/ ts0 (sslength ob1)) 2 2))
(prin1))

(defun c:qh()
(setq olderr *error* *error* myerr)
(setq h (getvar "TEXTSIZE"))
(setq ob1 (ssget) pp 0 ts0 0)
(repeat (sslength ob1)
  (setq p1 (entget (ssname ob1 pp)))
  (setq pp (+ 1 pp) an (assoc 0 p1))
  (if (= "TEXT" (cdr an)) (setq p1 (atof (cdr (assoc 1 p1))) ts0 (+ ts0 p1))))
(setq pp (getpoint "\nText_position:"))
(command "text" pp h 0 (rtos ts0 2 2))
(prin1))

(defun c:bh()
(setq olderr *error* *error* myerr)
(setvar "osmode" 1024)
(setq h (getvar "textsize"))
(setq js (getint "\nstart number :"))
(setq pp (getpoint "\ntext position :"))
(while (not (null pp))
  (command "text" pp h "0" (rtos js 2 0))
  (setq js (+ js 1) pp (getpoint "\ntext position :"))))

(defun c:wth()
(setq olderr *error* *error* myerr)
(setq h (getvar "textsize"))
(setq p1 (entget (car (entsel))))
(setq p1 (cdr (assoc 1 p1)))
(setvar "osmode" 33)
(setq pp (getpoint "\nText_position:"))
(setvar "osmode" 1024)
(setq pp (polar (polar pp (/ pi 2) (* h 0.2)) 0 (* h 0.9)))
(command "text" pp h "0" p1)
(prin1))

(defun c:pcjdst()
(setq olderr *error* *error* myerr)
(setq h (getvar "textsize"))
(setq fina (getstring "\ndata file name :"))
(setq p1 (entsel))
(while (not (null p1))
  (setq p1 (entget (car p1)))
  (setq p1 (atoi (cdr (assoc 1 p1))))
  (setq fre (open fina "r"))
  (setq ts (read-line fre) n 1) (st)
  (while (/= p1 (atoi ts0))
   (setq ts (read-line fre) n 1) (st))
  (close fre)
  (setvar "osmode" 33)
  (setq pp (getpoint "\nText_position:"))
  (setvar "osmode" 1024)
  (setq pp (polar (polar pp (/ pi 2) (* h 0.2)) 0 (* h 0.7)) n (+ n 1))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1))
  (command "text" (polar pp (/ pi 2) (* h 1.7)) h "0" (substr ts0 1 5))
  (command "text" (polar pp (/ pi 2) (* h 3.4)) h "0" (substr ts n 5))
  (setq p1 (entsel)))
(prin1))

(defun c:pcgd()
(setq olderr *error* *error* myerr)
(setvar "osmode" 1024)
(setq h (getvar "textsize"))
(setq fina (getstring "\ndata file name :"))
(setq p1 (entsel))
(while (not (null p1))
  (setq p1 (entget (car p1)))
  (setq p1 (atoi (cdr (assoc 1 p1))))
  (setq fre (open fina "r"))
  (setq ts (read-line fre) n 1) (st)
  (while (/= p1 (atoi ts0))
   (setq ts (read-line fre) n 1) (st))
  (close fre)
  (setq ob1 (entsel "\nselect line:"))
  (setq pp (entget (car ob1)))
  (setq pp1 (cdr (assoc 10 pp)))
  (setq pp2 (cdr (assoc 11 pp)))
  (if (< (car pp1) (car pp2))
  (setq ang (angle pp1 pp2)) (setq ang (angle pp2 pp1)))
  (setq angtext (/ (* ang 180.0) pi))
  (setq pp (list (caadr ob1) (car (cdadr ob1))))
  (setq n (+ n 1))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1) tss ts0)
  (st) (setq n (+ n 1) tss (strcat tss "-" ts0))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1) tss1 (rtos (atof ts0) 2 2))
  (st) (setq n (+ n 1) tss (strcat tss "-" (rtos (atof ts0) 2 2)))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1) tss1 (strcat tss1 "-" (rtos (atof ts0) 2 2)))
  (st) (setq tss1 (strcat tss1 "-" (rtos (atof (substr ts (+ n 1))) 2 2)))
  (command "text" (polar pp (+ (/ pi 2) ang) (* h 0.75)) h angtext tss)
  (command "text" (polar pp (+ (* pi 1.5) ang) (* h 1.75)) h angtext tss1)
  (setq p1 (entsel)))
(prin1))

(defun c:pcjdll()
(setq olderr *error* *error* myerr)
(setq h (getvar "textsize"))
(setq fina (getstring "\ndata file name :"))
(setq p1 (entsel))
(while (not (null p1))
  (setq p1 (entget (car p1)))
  (setq p1 (atoi (cdr (assoc 1 p1))))
  (setq fre (open fina "r"))
  (setq ts (read-line fre) n 1) (st)
  (while (/= p1 (atoi ts0))
   (setq ts (read-line fre) n 1) (st))
  (close fre)
  (setvar "osmode" 33)
  (setq pp1 (getpoint "\npoint:"))
  (setvar "osmode" 1024)
  (setq pp (getpoint "\nto:"))
  (setq ang (+ (angle pp1 pp) (/ (* pi 185) 180)))
  (command "line" pp1 pp (polar pp ang (/ (distance pp1 pp) 3.5)) "")
  (if (<= (car (cdr pp1)) (car (cdr pp)))
  (setq ang (/ pi 2) l (/ h 2)) (setq ang (* pi 1.5) l (* h 1.5)))
  (setq pp (polar pp ang l) n (+ n 1))
  (if (<= (car pp1) (car pp))
  (setq ang 0 l (/ h 5)) (setq ang pi l (* h 3)))
  (setq pp (polar pp ang l))
  (st) (setq n (+ n 1))
  (st) (setq n (+ n 1))
  (command "text" pp h "0" (substr ts0 (if (= (substr ts0 1 1) "-") 2 1) 5))
  (setq p1 (entsel)))
(prin1))

(defun st()
(setq ts0 "")
(while (/= (substr ts n 1) ",")
  (setq ts0 (strcat ts0 (substr ts n 1)))
  (setq n (+ n 1))))

(defun myerr (st)
(if (/= st "Function cancelled")
  (princ (strcat "\nError: " st)))
(setq *error* olderr)
(princ))

(DEFUN C:ZD()
(setq js 2)
(while (< js 23) (grtext js " ") (setq js (+ js 1)))
(grtext 0 "ZD")
(grtext 3 "ROAD")
(grtext 4 "WATER")
(grtext 5 "G_WATER")
(grtext 6 "GAS")
(grtext 8 "CALCULAT")
(grtext 10 "EXIT")
(setq olderr *error* *error* myerr tot zer0)
(while (= tot nil) (setq re (grread))
  (if (or (= (car re) 2) (= (car re) 4)) (progn
    (if (= (car re) 4) (setq re (car (cdr re))) (progn
      (setq re (car (cdr re)))
      (if (> re 96) (setq re (- re 32)))
      (cond ((= re 82) (setq re 3))
            ((= re 87) (setq re 4))
            ((= re 71) (setq re 5))
            ((= re 67) (setq re 8))
            ((= re 69) (setq re 10)))))
  (cond ((= re 3) (PROGN (LOAD "ROAD") (C:ROAD)))
        ((= re 4) (PROGN (LOAD "WATER") (C:WATER)))
        ((= re 5) (PROGN (LOAD "WATER-G") (C:WATER-G)))   
        ((= re 6) (PROGN (LOAD "GAS") (C:GAS)))
        ((= re 8) (PROGN (LOAD "CALCUL") (C:CALCUL)))
        ((= re 10) (SETQ tot 1))))))
(setq *error* olderr)
(GRTEXT) (PRIN1))

xiaochongcn

小工具不错。
收藏了。

shuaier

有些是我从网上收集的，把它拿来共享，以后慢慢在上传

gongfan

背景色变为透明的怎么没反映的啊

shuaier

先在CAD中将背景设为透明（注意不是CAD中绘图区的背景，一般是看不到效果的），再将CAD图拷贝到WORD中之后就可以看到效果了。

神佑我心

规划词典等资料在哪里？

shuaier

在一楼的附件里，是我从网上收集的。

xxmyna

倒是不错的小工具~~

hnzzhgy

good

luob72

谢谢版主啊

aq0202

坐标标注程序这个不错