请教关于打散和合并属性块的问题
本帖最后由 wmz 于 2014-9-29 17:12 编辑;;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的
;;;;;我现在用了一种办法但感觉实在是太笨了！请教哪位大侠能指教一二！
;;;;;以下是我的代码：
(vl-load-com)
;;;打散
(defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.4) ZG (* 2.0 blxs))
(setq s (ssget))
(setq n (sslength s) m 0)
(repeat n
(setq s0 (ssname s m) m (+ m 1) k 0)
(setq s1 (entget s0 (list "SOUTH")))
(setq d1 (cdr(assoc 10 s1)))
(setq JD (cdr(assoc 50 s1)))
(setqb (cdadr (cadr (assoc -3 s1))))
(setqb (vl-princ-to-string b))
(setqb (vl-string-translate "" "" B))
(cond ((= b "202101")(setq height (last d1))
(command "_.erase" s0 "")
(MKINSERT d1 bl bl bl JD "202101")
(MKTEXTA d1 ZG JD (rtos height 2 2) "202111")
)
((= b "186400")(setq H (rtos (last d1) 2 1))
(command "_.erase" s0 "")
(setq k (vl-string-search "." h))
(setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
(MKINSERT d1 bl bl bl JD "186400")
(MKTEXTB d1 ZG JD h1 "186411")
(MKTEXTC d1 ZG JD h2 "186412")
)
)
)
)
;;;合并
(defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.4) ZG (* 2.0 blxs))
(setq s (ssget))
(setq n (sslength s) m 0)(print "n=")(princ n)(princ)
(repeat n
(setqs0 (ssname s m) m (+ m 1) k 0)
(setqs1 (entget s0 (list "SOUTH")))
(setq lay (cdr(assoc 8 s1)))
(setq e (cdr (assoc 0 s1)))
(if (and(= e "TEXT")(= lay "GCD"))(command "erase" s0 ""))
(if (and(= e "INSERT")(= lay "GCD"))(progn
(setq d1 (cdr(assoc 10 s1)))
(setq JD (cdr(assoc 50 s1)))
(setqb (cdadr (cadr (assoc -3 s1))))
(setqb (vl-princ-to-string b))
(setqb (vl-string-translate "" "" B))
(cond ((= b "202101")(setq height (rtos (last d1) 2 2))
(command "_.erase" s0 "")
(MINSERTAA d1 (/ bl 2.0) height)
)
((= b "186400")(setq H (rtos (last d1) 2 1))
(command "_.erase" s0 "")
(setq k (vl-string-search "." h))
(setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
(MINSERTSS d1 (/ bl 2.0) JD h1 h2)
)
)
))
)
)
;;插入块打散后用
(defun MKINSERT (PT SX SY SSZ ZJ DATA)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbBlockReference")
(cons 2 "GC200")
(cons 8 "GCD")
(cons 10 PT)
(cons 41 SX)
(cons 42 SY)
(cons 43 SSZ)
(cons 50 ZJ)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字岸上点打散后用
(defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)
(setq pty (polar pt ANG 0.5))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PT)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 72 0);;左对齐
(cons 73 2)
(cons 11 pty)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字水下点左打散后用
(defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)
(setq ptz (polar pt ANG -0.3))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PT)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 11 ptz)
(cons 72 2);;右对齐
(cons 73 0)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字水下点右打散后用
(defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)
(setq pty (polar pt ANG 0.2))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PTy)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 11 pty)
(cons 72 0);;左对齐
(cons 73 0)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;插入块(岸上点)合并用
(defun MINSERTAA (inspt scale height / pt)
(setq pt (polar inspt 0 (* 1.2 scale)))
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
'(-3 ("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "HZ")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 70 0)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;插入块(水下点)合并用
(defun MINSERTSS (inspt scale JD integer decimal / pt ptz pty)
(setq pt (polar inspt 0 (* 1.2 scale)))
(setq ptz (polar pt jd -0.4))
(setq pty (polar pt jd 0.2))
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(cons 50 JD)
'(-3 ("SOUTH" (1000 . "186400")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 JD)
(cons 41 0.8)
(cons 51 0)
(cons 1 integer)
(cons 7 "HZ")
(cons 72 2);;右对齐
(cons 11 ptz)
'(100 . "AcDbAttribute")
(cons 2 "integer")
(cons 70 0);;;;;南方CASS的地形点是用的属性块，他有打散和合并功能，不知是如何实现的
;;;;;我现在用了一种办法但感觉实在是太笨了！请教哪位大侠能指教一二！
;;;;;以下是我的代码：
(vl-load-com)
;;;打散
(defun c:DSKY (/ bl blc blxs ZG s n s0 s1 d1 m k jd b)
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.4) ZG (* 2.0 blxs))
(setq s (ssget))
(setq n (sslength s) m 0)
(repeat n
(setq s0 (ssname s m) m (+ m 1) k 0)
(setq s1 (entget s0 (list "SOUTH")))
(setq d1 (cdr(assoc 10 s1)))
(setq JD (cdr(assoc 50 s1)))
(setqb (cdadr (cadr (assoc -3 s1))))
(setqb (vl-princ-to-string b))
(setqb (vl-string-translate "" "" B))
(cond ((= b "202101")(setq height (last d1))
(command "_.erase" s0 "")
(MKINSERT d1 bl bl bl JD "202101")
(MKTEXTA d1 ZG JD (rtos height 2 2) "202111")
)
((= b "186400")(setq H (rtos (last d1) 2 1))
(command "_.erase" s0 "")
(setq k (vl-string-search "." h))
(setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
(MKINSERT d1 bl bl bl JD "186400")
(MKTEXTB d1 ZG JD h1 "186411")
(MKTEXTC d1 ZG JD h2 "186412")
)
)
)
)
;;;合并
(defun c:HBKY (/ bl blc blxs ZG lay s n s0 s1 d1 m k jd b)
(command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" """")
(setq blc (getvar "userr1") blxs (/ blc 1000.0))
(setqbl (* blxs 0.4) ZG (* 2.0 blxs))
(setq s (ssget))
(setq n (sslength s) m 0)(print "n=")(princ n)(princ)
(repeat n
(setqs0 (ssname s m) m (+ m 1) k 0)
(setqs1 (entget s0 (list "SOUTH")))
(setq lay (cdr(assoc 8 s1)))
(setq e (cdr (assoc 0 s1)))
(if (and(= e "TEXT")(= lay "GCD"))(command "erase" s0 ""))
(if (and(= e "INSERT")(= lay "GCD"))(progn
(setq d1 (cdr(assoc 10 s1)))
(setq JD (cdr(assoc 50 s1)))
(setqb (cdadr (cadr (assoc -3 s1))))
(setqb (vl-princ-to-string b))
(setqb (vl-string-translate "" "" B))
(cond ((= b "202101")(setq height (rtos (last d1) 2 2))
(command "_.erase" s0 "")
(MINSERTAA d1 (/ bl 2.0) height)
)
((= b "186400")(setq H (rtos (last d1) 2 1))
(command "_.erase" s0 "")
(setq k (vl-string-search "." h))
(setq h1 (substr h 1 k) h2 (substr h (+ k 2) 1))
(MINSERTSS d1 (/ bl 2.0) JD h1 h2)
)
)
))
)
)
;;插入块打散后用
(defun MKINSERT (PT SX SY SSZ ZJ DATA)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbBlockReference")
(cons 2 "GC200")
(cons 8 "GCD")
(cons 10 PT)
(cons 41 SX)
(cons 42 SY)
(cons 43 SSZ)
(cons 50 ZJ)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字岸上点打散后用
(defun MKTEXTA (PT HEI ANG STR DATA / PTX TOBJ)
(setq pty (polar pt ANG 0.5))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PT)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 72 0);;左对齐
(cons 73 2)
(cons 11 pty)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字水下点左打散后用
(defun MKTEXTB (PT HEI ANG STR DATA / PTz TOBJ)
(setq ptz (polar pt ANG -0.3))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PT)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 11 ptz)
(cons 72 2);;右对齐
(cons 73 0)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;写文字水下点右打散后用
(defun MKTEXTC (PT HEI ANG STR DATA / PTy TOBJ)
(setq pty (polar pt ANG 0.2))
(entmake (list '(0 . "TEXT")
(cons 7 "HZ")
(cons 8 "GCD")
(cons 10 PTy)
(cons 40 HEI) ;;字高
(cons 41 0.8)
(cons 50 ANG)
(cons 1 STR)
(cons 11 pty)
(cons 72 0);;左对齐
(cons 73 0)
(list -3 (list "SOUTH" (cons 1000 DATA)))
)
)
)
;;;插入块(岸上点)合并用
(defun MINSERTAA (inspt scale height / pt)
(setq pt (polar inspt 0 (* 1.2 scale)))
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
'(-3 ("SOUTH" (1000 . "202101")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 0)
(cons 41 0.8)
(cons 51 0)
(cons 1 height)
(cons 7 "HZ")
(cons 72 0)
(cons 11 pt)
'(100 . "AcDbAttribute")
(cons 2 "height")
(cons 70 0)
(cons 74 2)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
;;;插入块(水下点)合并用
(defun MINSERTSS (inspt scale JD integer decimal / pt ptz pty)
(setq pt (polar inspt 0 (* 1.2 scale)))
(setq ptz (polar pt jd -0.4))
(setq pty (polar pt jd 0.2))
(entmake (list
'(0 . "INSERT")
'(100 . "AcDbEntity")
'(100 . "AcDbBlockReference")
'(66 . 1);;;属性跟随标志,1跟随，0不跟随
(cons 2 "GC200")
(cons 10 inspt)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(cons 50 JD)
'(-3 ("SOUTH" (1000 . "186400")))
)
)
;;;插入属性
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 JD)
(cons 41 0.8)
(cons 51 0)
(cons 1 integer)
(cons 7 "HZ")
(cons 72 2);;右对齐
(cons 11 ptz)
'(100 . "AcDbAttribute")
(cons 2 "integer")
(cons 70 0)
(cons 73 2)
(cons 74 1)
)
)
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 JD)
(cons 41 0.8)
(cons 51 0)
(cons 1 decimal)
(cons 7 "HZ")
(cons 72 0) ;;左对齐
(cons 11 pty)
'(100 . "AcDbAttribute")
(cons 2 "decimal")
(cons 70 0)
(cons 73 2)
(cons 74 1)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
(cons 73 2)
(cons 74 1)
)
)
(entmake (list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 10.0 scale))
(cons 50 JD)
(cons 41 0.8)
(cons 51 0)
(cons 1 decimal)
(cons 7 "HZ")
(cons 72 0) ;;左对齐
(cons 11 pty)
'(100 . "AcDbAttribute")
(cons 2 "decimal")
(cons 70 0)
(cons 73 2)
(cons 74 1)
)
)
;;;结束标志
(entmake '((0 . "SEQEND")))
(princ)
)
页:
[1]