Jump to content

Change to lisp routine

JudiHughes

By JudiHughes
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

JudiHughes Newbie

JudiHughes

Posted
Posted

Hi all,

I have this lisp routine I downloaded from the web but it is in imperial dims and I need it to be metric meters to 3 decimal points the angles are in degrees and fine.

Not great with lisp so any help appreciated.

 

Judi

DimPline.lsp

  • Like 1
confutatis Enthusiast

confutatis

Posted
Posted (edited) 
(defun c:DimPline2 ( / adoc space obj_dim obj_angdim height_dim pl ent obj dxf_ent ll ur dir_pt base_pt dir_ang last_pt pr_pt lst_pt nw_obj)
	(vl-load-com)
	(setq	adoc (vla-get-activedocument (vlax-get-acad-object))
		space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-paperspace adoc)
			(vla-get-modelspace adoc)
		)
		obj_dim (vla-add (vla-get-Dimstyles adoc) "DIMPLINE")
		obj_angdim (vla-add (vla-get-Dimstyles adoc) "DIMANGPLINE")
	)
	(vla-put-activedimstyle adoc obj_dim)
	(initget 6)
	(setq height_dim (getdist (getvar "VIEWCTR") (strcat "\nHeight of dim text <" (rtos (getvar "DIMTXT")) ">: ")))
	(if height_dim (vla-setvariable adoc "DIMTXT" height_dim) (setq height_dim (getvar "DIMTXT")))
	(mapcar '(lambda (data_list / ) (vla-setvariable adoc (car data_list) (cdr data_list)))
		(list
			(cons "DIMPOST" "")
			(cons "DIMAPOST" "")
			(cons "DIMSCALE" 1.0)
			(cons "DIMASZ" (getvar "DIMTXT"))
			(cons "DIMEXO" (/ (getvar "DIMTXT") 2.54))
			(cons "DIMDLI" 0.38)
			(cons "DIMEXE" (/ (getvar "DIMTXT") 2.54))
			(cons "DIMRND" 0.0)
			(cons "DIMDLE" (/ (getvar "DIMTXT") 2.54))
			(cons "DIMTP" 0.0)
			(cons "DIMTM" 0.0)
			(cons "DIMCEN" 0.09)
			(cons "DIMTSZ" 0.0)
			(cons "DIMALTF" 25.4)
			(cons "DIMLFAC" 1.0)
			(cons "DIMTVP" 0.0)
			(cons "DIMTFAC" 1.0)
			(cons "DIMGAP" (/ (getvar "DIMTXT") 2.00))
			(cons "DIMALTRND" 0.0)
			(cons "DIMTOL" 0)
			(cons "DIMLIM" 0)
			(cons "DIMTIH" 0)
			(cons "DIMTOH" 0)
			(cons "DIMSE1" 0)
			(cons "DIMSE2" 0)
			(cons "DIMTAD" 1)
			(cons "DIMZIN" 0)
			(cons "DIMALT" 0)
			(cons "DIMALTD" 2)
			(cons "DIMTOFL" 1)
			(cons "DIMSAH" 0)
			(cons "DIMTIX" 0)
			(cons "DIMSOXD" 0)
			(cons "DIMCLRD" 3)
			(cons "DIMCLRE" 1)
			(cons "DIMCLRT" 3)
			(cons "DIMADEC" 2)
			(cons "DIMDEC" 3)
			(cons "DIMTDEC" 3)
			(cons "DIMALTU" 6)
			(cons "DIMALTTD" 2)
			(cons "DIMAUNIT" 0)
			(cons "DIMFRAC" 2)
			(cons "DIMLUNIT" 2)
			(cons "DIMDSEP" ".")
			(cons "DIMTMOVE" 0)
			(cons "DIMJUST" 0)
			(cons "DIMSD1" 0)
			(cons "DIMSD2" 0)
			(cons "DIMTOLJ" 1)
			(cons "DIMTZIN" 0)
			(cons "DIMALTZ" 0)
			(cons "DIMALTTZ" 0)
			(cons "DIMUPT" 0)
			(cons "DIMATFIT" 3)
			(cons "DIMBLK" "_ARCHTICK")
		)
	)
	(vla-copyfrom obj_dim adoc)
	(vla-setvariable adoc "DIMBLK" ".")
	(vla-copyfrom obj_angdim adoc)
	(princ "\nSelect polylines: ")
	(while (null (setq pl (ssget '((0 . "LWPOLYLINE"))))))
	(repeat (setq n (sslength pl))
		(setq
			ent (ssname pl (setq n (1- n)))
			obj (vlax-ename->vla-object ent)
			dxf_ent (entget ent)
			lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
		)
		(vla-GetBoundingBox obj 'll 'ur)
		(setq
			ll (safearray-value ll)
			ur (safearray-value ur)
			dir_pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
			base_pt (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt))
			dir_ang
			(if (< (- (angle base_pt (polar base_pt (+ (angle (car lst_pt) (cadr lst_pt)) (* 0.5 pi)) (getvar "DIMTXT"))) (angle base_pt dir_pt)) pi)
				(* pi 0.5)
				(* pi 1.5)
			)
		)
		(if (not (zerop (logand 1 (cdr (assoc 70 dxf_ent)))))
			(setq last_pt (car lst_pt) lst_pt (cons (last lst_pt) lst_pt) pr_pt (last lst_pt))
			(setq pr_pt nil)
		)
		(while (cdr lst_pt)
			(vla-put-activedimstyle adoc obj_dim)
			(setq nw_obj
				(vla-addDimAligned
					space
					(vlax-3d-point (car lst_pt))
					(vlax-3d-point (cadr lst_pt))
					(vlax-3d-point (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt)))
				)
			)
			(vlax-put nw_obj 'TextPosition (polar (vlax-get nw_obj 'TextPosition) (+ (angle (car lst_pt) (cadr lst_pt)) (+ dir_ang pi))(* 3.25 (getvar "DIMTXT"))))
			(if pr_pt
				(progn
					(vla-put-activedimstyle adoc obj_angdim)
					(setq nw_obj
						(vla-AddDimAngular
							space
							(vlax-3d-point (car lst_pt))
							(vlax-3d-point (cadr lst_pt))
							(vlax-3d-point pr_pt)
							(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 5.0 (getvar "DIMTXT"))))
						)
						pr_pt (car lst_pt)
					)
				)
				(setq pr_pt (car lst_pt))
			)
			(setq lst_pt (cdr lst_pt))
		)
		(if (and pr_pt last_pt)
			(setq nw_obj
				(vla-AddDimAngular
					space
					(vlax-3d-point (car lst_pt))
					(vlax-3d-point pr_pt)
					(vlax-3d-point last_pt)
					(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 3.25 (getvar "DIMTXT"))))
				)
				pr_pt (car lst_pt)
			)
		)
	)
	(princ)
)

 

I changed the variables DIMDEC=3, DIMTDEC=3 and DIMLUNIT=2. The variable DIMGAP was fixed at 0.09, I made it change with the height of the text so that the distance is proportionate to the dimension line. There was an error at the end of the program, it warned me of an unknown point and in fact the variable last_pt was nil. Very interesting little program. You don't have time to learn the dimension variables in one version of AutoCAD and Autodesk comes up with new variables, which I obviously don't remember, and as I've already told my buddy Mhupp, I'm lazy...

Edited by confutatis
  • Like 1
zwonko Collaborator

zwonko

Posted
Posted

Really nice code!!!!

Changed it to use current dimstyle, not adding new one. 

(defun c:DimPline2zw ( / adoc space obj_dim obj_angdim height_dim pl ent obj dxf_ent ll ur dir_pt base_pt dir_ang last_pt pr_pt lst_pt nw_obj)
	(vl-load-com)
	(setq	adoc (vla-get-activedocument (vlax-get-acad-object))
		space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-paperspace adoc)
			(vla-get-modelspace adoc)
		)
		
		
	)
	;;(vla-put-activedimstyle adoc obj_dim)
	;;(initget 6)



	;;(vla-copyfrom obj_dim adoc)
	;;(vla-setvariable adoc "DIMBLK" ".")
	;;(vla-copyfrom obj_angdim adoc)
	(princ "\nSelect polylines: ")
	(while (null (setq pl (ssget '((0 . "LWPOLYLINE"))))))
	(repeat (setq n (sslength pl))
		(setq
			ent (ssname pl (setq n (1- n)))
			obj (vlax-ename->vla-object ent)
			dxf_ent (entget ent)
			lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
		)
		(vla-GetBoundingBox obj 'll 'ur)
		(setq
			ll (safearray-value ll)
			ur (safearray-value ur)
			dir_pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
			base_pt (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt))
			dir_ang
			(if (< (- (angle base_pt (polar base_pt (+ (angle (car lst_pt) (cadr lst_pt)) (* 0.5 pi)) (getvar "DIMTXT"))) (angle base_pt dir_pt)) pi)
				(* pi 0.5)
				(* pi 1.5)
			)
		)
		(if (not (zerop (logand 1 (cdr (assoc 70 dxf_ent)))))
			(setq last_pt (car lst_pt) lst_pt (cons (last lst_pt) lst_pt) pr_pt (last lst_pt))
			(setq pr_pt nil)
		)
		(while (cdr lst_pt)
			;;(vla-put-activedimstyle adoc obj_dim)
			(setq nw_obj
				(vla-addDimAligned
					space
					(vlax-3d-point (car lst_pt))
					(vlax-3d-point (cadr lst_pt))
					(vlax-3d-point (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt)))
				)
			)
			(vlax-put nw_obj 'TextPosition (polar (vlax-get nw_obj 'TextPosition) (+ (angle (car lst_pt) (cadr lst_pt)) (+ dir_ang pi))(* 3.25 (getvar "DIMTXT"))))
			(if pr_pt
				(progn
					;;(vla-put-activedimstyle adoc obj_angdim)
					(setq nw_obj
						(vla-AddDimAngular
							space
							(vlax-3d-point (car lst_pt))
							(vlax-3d-point (cadr lst_pt))
							(vlax-3d-point pr_pt)
							(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 95.0 (getvar "DIMTXT"))))
						)
						pr_pt (car lst_pt)
					)
				)
				(setq pr_pt (car lst_pt))
			)
			(setq lst_pt (cdr lst_pt))
		)
		(if (and pr_pt last_pt)
			(setq nw_obj
				(vla-AddDimAngular
					space
					(vlax-3d-point (car lst_pt))
					(vlax-3d-point pr_pt)
					(vlax-3d-point last_pt)
					(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 95 (getvar "DIMTXT"))))
				)
				pr_pt (car lst_pt)
			)
		)
	)
	(princ)
)

 

But there is small problem with dimstyle override for angular dimensions. Look on sample dwg. Is any way to correct it? Thinking about get back to previous code with chosen styles, and for angulat it should get dimstyle named "currdimstyle+$2"

test.dwg

confutatis Enthusiast

confutatis

Posted
Posted

In fact you should use two styles, one for linear dimensions and one for angles. If you manage the dimensions with DDIM, you can change the appearance of the corner by restoring the dimension lines, but afterwards it also displays the elements of the linear dimensions.

JudiHughes Newbie

JudiHughes

Posted
  • Author
Posted

Thanks All,

Both worked fine and once again thanks for all your help.

 

Judi

zwonko Collaborator

zwonko

Posted
Posted

So for my purposes the code looks like below: 

(defun c:rbrdesc ( / adoc space obj_dim obj_dimm obj_angdim obj_angdimm height_dim pl ent obj dxf_ent ll ur dir_pt base_pt dir_ang last_pt pr_pt lst_pt nw_obj)
	;;(princ "\nworking: ")
(setq obj_dimm (GETVAR "DIMSTYLE"))
(setq obj_angdimm (GETVAR "DIMSTYLE"))
(setq obj_dimm (strcat obj_dimm))
(setq obj_angdimm (strcat obj_angdimm "$2"))
	;;(princ "\nworking1: ")
	(vl-load-com)
	(setq	adoc (vla-get-activedocument (vlax-get-acad-object))
		space
		(if (= 1 (getvar "CVPORT"))
			(vla-get-paperspace adoc)
			(vla-get-modelspace adoc)
		)

		obj_dim (vla-add (vla-get-Dimstyles adoc) obj_dimm)
		obj_angdim (vla-add (vla-get-Dimstyles adoc) obj_angdimm)
	)
	(vla-put-activedimstyle adoc obj_dim)
	(initget 6)
	;;(princ "\nworking2: ")


	;;(vla-copyfrom obj_dim adoc)
	;;(vla-setvariable adoc "DIMBLK" ".")
	;;(vla-copyfrom obj_angdim adoc)
	(princ "\nSelect polylines: ")
	(while (null (setq pl (ssget '((0 . "LWPOLYLINE"))))))
	(repeat (setq n (sslength pl))
		(setq
			ent (ssname pl (setq n (1- n)))
			obj (vlax-ename->vla-object ent)
			dxf_ent (entget ent)
			lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
		)
		(vla-GetBoundingBox obj 'll 'ur)
		(setq
			ll (safearray-value ll)
			ur (safearray-value ur)
			dir_pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
			base_pt (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt))
			dir_ang
			(if (< (- (angle base_pt (polar base_pt (+ (angle (car lst_pt) (cadr lst_pt)) (* 0.5 pi)) (getvar "DIMTXT"))) (angle base_pt dir_pt)) pi)
				(* pi 0.5)
				(* pi 1.5)
			)
		)
		(if (not (zerop (logand 1 (cdr (assoc 70 dxf_ent)))))
			(setq last_pt (car lst_pt) lst_pt (cons (last lst_pt) lst_pt) pr_pt (last lst_pt))
			(setq pr_pt nil)
		)
		(while (cdr lst_pt)
			(vla-put-activedimstyle adoc obj_dim)
			(setq nw_obj
				(vla-addDimAligned
					space
					(vlax-3d-point (car lst_pt))
					(vlax-3d-point (cadr lst_pt))
					(vlax-3d-point (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt)))
				)
			)
			(vlax-put nw_obj 'TextPosition (polar (vlax-get nw_obj 'TextPosition) (+ (angle (car lst_pt) (cadr lst_pt)) (+ dir_ang pi))(* 3.25 (getvar "DIMTXT"))))



;;(setq obj (vlax-ename->vla-object (entlast)))
;;(wcmatch (strcase (vla-get-objectname obj)) "*DIM*")
;;(setq txt (vla-get-measurement obj))
;;(if (= txt 100)
;;(vla-delete obj)
;;)



(if pr_pt
				(progn
					(vla-put-activedimstyle adoc obj_angdim)
					(setq nw_obj
						(vla-AddDimAngular
							space
							(vlax-3d-point (car lst_pt))
							(vlax-3d-point (cadr lst_pt))
							(vlax-3d-point pr_pt)
							(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 95.0 (getvar "DIMTXT"))))
						)
						pr_pt (car lst_pt)
					)

(setq obj (vlax-ename->vla-object (entlast)))
;;(wcmatch (strcase (vla-get-objectname obj)) "*DIM*")
(setq txt (vla-get-measurement obj))
(if (= txt (/ pi 2))
(vla-delete obj)
)
				)



				(setq pr_pt (car lst_pt))
			)
			(setq lst_pt (cdr lst_pt))
		)
		(if (and pr_pt last_pt)
			(setq nw_obj
				(vla-AddDimAngular
					space
					(vlax-3d-point (car lst_pt))
					(vlax-3d-point pr_pt)
					(vlax-3d-point last_pt)
					(vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) dir_pt) (* 95 (getvar "DIMTXT"))))
				)
				pr_pt (car lst_pt)
			)
		)
;;(setvar "DIMSTYLE" "standard")
(command "-DIMSTYLE" "restore" obj_dimm)
	)
	(princ)
)

 

 

Main changes are:

-it is getting current dimstyle

-it is working within dimangular with dimstyle overide for angular dimensions

-it should delete dimang if it is 90degress

-also turn of one code line which was making aligned dimension "not compatibile" with lisp below (getting dimtext up/down)

  

(defun c:dimupd ( / sel )
   (if (ssget "_:L" '((0 . "DIMENSION")))
       (progn
           (vlax-for obj
               (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
               (if (= acunder (vla-get-verticaltextposition obj))
                   (vla-put-verticaltextposition obj acabove)
                   (vla-put-verticaltextposition obj acunder)
               )
           )
           (vla-delete sel)
       )
   )
   (princ)
)
(vl-load-com) (princ)

 

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...