[Lisp] 칫수 배경 리습 소수점치수도 가능하게 변경 요청

[CAD형님]

칫수 배경 리습.LSP

2.23KB

안녕하세요? 치수배경리습 사용중 글을 올립니다.

현재 리습은 치수 텍스트에 배경이 채워 지는 리습입니다. 그냥 정치수 일때는 배경이 잘 들어 가는데

소수점일 경우에 정치수로 변경된후에 배경이 들어갑니다.

소수점 치수일 경우에도 그 상태에서 배경이 추가되게 변경 하고 싶습니다

감사합니다.

;====================================================
; 치수 배경 On-Off
;===================================================

(defun c:DD1 (/ GetXdata entdata newentdata ss1 plst vlst dblk1 dblk2)
(vl-load-com)

(defun GetXdata (objSelection / intCount lstAll lstSub safDXFValues safDXFValues)
(if (= (type objSelection) 'ENAME)
(setq objSelection (vlax-ename->vla-object objSelection))
)
(vla-getxdata objSelection "" 'safDXFCodes 'safDXFValues) 
(if 
(and 
safDXFCodes
safDXFValues
)
(progn
(setq 
lstDXFCodes  (vlax-safearray->list safDXFCodes)  
lstDXFValues (mapcar 'variant-value (vlax-safearray->list safDXFValues))  
intCount 0
)
(foreach intDXFCode lstDXFCodes
(if (= intDXFCode 1001)
(if lstSub
(setq 
lstAll (cons (reverse lstSub) lstAll)
lstSub (list (nth intCount lstDXFValues))
)
(setq lstSub (list (nth intCount lstDXFValues)))  
)
(setq lstSub (cons (nth intCount lstDXFValues) lstSub))   
)
(setq intCount (1+ intCount))
)
(if lstSub (reverse (cons (reverse lstSub) lstAll)))
)
)
)
(setq ss1 (ssget '((0 . "Dimension"))))
(setq plst 
'( DimensionLineColor DimLine1Suppress DimLine2Suppress 
ExtensionLineColor ExtLine1Suppress ExtLine2Suppress
TextStyle TextColor TextHeight ScaleFactor LinearScaleFactor
ArrowheadSize
)
)
(foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
(setq vlst nil)
(mapcar
'(lambda (p) (setq vlst (cons (vlax-get-property obj p) vlst)))
plst
)
(setq dblk1 (vlax-get-property obj 'Arrowhead1Block))
(setq dblk2 (vlax-get-property obj 'Arrowhead2Block))

(if (or 
(= (cadr (member 69 (assoc "ACAD" (getxdata obj)))) 0)
(= (cadr (member 69 (assoc "ACAD" (getxdata obj)))) nil)
)
(setq entdata '((-3 ("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 69) (1070 . 1) (1002 . "}")))))
(setq entdata '((-3 ("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 69) (1070 . 0) (1002 . "}")))))
)
(setq newentdata (append (entget (vlax-vla-object->ename obj)) entdata))
(entmod newentdata)
(mapcar
'(lambda (p v) (vlax-put-property obj p v))
plst
(reverse vlst)
)
(cond 
((= dblk1 "") (vlax-put-property obj 'Arrowhead1Type 0))
((= dblk2 "") (vlax-put-property obj 'Arrowhead2Type 0))
)
)
(vl-cmdf "_draworder" ss1 "" "f")
(princ)
)

[도도도]

(setq plst
'(
DimensionLineColor DimLine1Suppress DimLine2Suppress
ExtensionLineColor ExtLine1Suppress ExtLine2Suppress
TextStyle TextColor TextHeight ScaleFactor LinearScaleFactor
ArrowheadSize PrimaryUnitsPrecision ; <-- 요놈을 추가 하세요
)
)

[CAD형님]

도도도님 감사합니다.

요놈을 추가 하니 잘 작동 합니다.

감사합니다