標註複線的scale比例

想請問版上的高手，我想要有自動標註複線比例的功能，目前code(下方)只能單一選取一個複線，我想要能夠選取多個複線，參考之前用的快速標記的code，應該可以用
(setq dpss (ssget "_:L" '((0 . "*MLINE"))))  這行達到，可是其他部分不太清楚要怎麼修改。想請大家幫忙把code更改成能夠選取多個複線嗎?

(defun c:mldim ( / olsnap dic obj xyz mlsty mlsc pt1 pt2 ang mp mp2 ent dic dict tot)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))

(setq obj (vlax-ename->vla-object (car (entsel "\nSelect mline"))))
(setq xyz (vlax-get obj 'Coordinates))
(setq mlsty (vlax-get obj 'StyleName))
(setq mlsc (vlax-get obj 'MLineScale))

(setq pt1 (list (nth 0 xyz)(nth 1 xyz)))
(setq pt2 (list (nth 3 xyz)(nth 4 xyz)))
(setq ang (- (angle pt1 pt2)(/ pi 2.0)))
(setq mp (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5)))


(setq dict (dictsearch (setq dic (cdr (assoc -1 dic))) mlsty ))
(setq tot 0.0)
(foreach ent dict
(if (= (car ent) 49)
(setq tot (+ tot (abs (cdr ent))))
)
)
(setq tot (* mlsc tot))

(setq mp2 (polar mp ang tot))

(command "dimaligned" mp mp2 mp)

(princ)
)

(c:mldim)

dog46 寫到:想請問版上的高手，我想要有自動標註複線比例的功能，目前code(下方)只能單一選取一個複線，我想要能夠選取多個複線，參考之前用的快速標記的code，應該可以用
(setq dpss (ssget "_:L" '((0 . "*MLINE"))))  這行達到，可是其他部分不太清楚要怎麼修改。想請大家幫忙把code更改成能夠選取多個複線嗎?

(defun c:mldim ( / olsnap dic obj xyz mlsty mlsc pt1 pt2 ang mp mp2 ent dic dict tot)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))

(setq obj (vlax-ename->vla-object (car (entsel "\nSelect mline"))))
(setq xyz (vlax-get obj 'Coordinates))
(setq mlsty (vlax-get obj 'StyleName))
(setq mlsc (vlax-get obj 'MLineScale))

(setq pt1 (list (nth 0 xyz)(nth 1 xyz)))
(setq pt2 (list (nth 3 xyz)(nth 4 xyz)))
(setq ang (- (angle pt1 pt2)(/ pi 2.0)))
(setq mp (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5)))


(setq dict (dictsearch (setq dic (cdr (assoc -1 dic))) mlsty ))
(setq tot 0.0)
(foreach ent dict
(if (= (car ent) 49)
(setq tot (+ tot (abs (cdr ent))))
)
)
(setq tot (* mlsc tot))

(setq mp2 (polar mp ang tot))

(command "dimaligned" mp mp2 mp)

(princ)
)

(c:mldim)

TO Dog46:
程式很好用,可惜的是位置偏位了,請問後來有對正到的標註的比例寬度嗎?想請教一下複線標註如何鎖定兩條線的中點?對正方式分為底部，頂部，零等位置.還有我想知道快速選取多個複線.謝謝!  


附圖

有其他想增加的再自行修改

代碼:

(defun c:mldim ( / olsnap dic dpss i ssn obj xyz mlsty mlsc pt1 pt2 ang mp mp2 ent dic dict tot)

(vl-load-com)

(setq oldsnap (getvar 'osmode))

(setvar 'osmode 0)

(vl-cmdf "_.ucs" "_world")

(princ "\n->Select mline:")

(setq dpss (ssget "_:S" '((0 . "*MLINE"))))

(while (null dpss)

(princ "\n->Select mline:")

(setq dpss (ssget "_:S" '((0 . "*MLINE"))))

)

(setq i 0)

(repeat (sslength dpss)

(setq ssn (ssname dpss i))

(setq obj (vlax-ename->vla-object ssn))
(setq xyz (vlax-get obj 'Coordinates))
(setq mlsty (vlax-get obj 'StyleName))
(setq mlsc (vlax-get obj 'MLineScale))

(setq dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))

(setq pt1 (list (nth 0 xyz)(nth 1 xyz)))
(setq pt2 (list (nth 3 xyz)(nth 4 xyz)))
(setq ang (- (angle pt1 pt2)(/ pi 2.0)))
(setq mp (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5)))


(setq dict (dictsearch (setq dic (cdr (assoc -1 dic))) mlsty ))
(setq tot 0.0)
(foreach ent dict
(if (= (car ent) 49)
(setq tot (+ tot (abs (cdr ent))))
)
)
(setq tot (* mlsc tot))

(setq mp2 (polar mp ang tot))

(vl-cmdf "dimaligned" mp mp2 mp)

(setq i (1+ i))

)

(vl-cmdf "_.ucs" "_p")

(princ)
)