(defun C:CTR (/ e_lst ocolor oltype odimcen)
(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cecolor" "celtype" "dimcen")) )
(defun *error* (msg)
(mapcar 'eval e_lst)
(princ "")
)
(setvar "cmdecho" 0)
(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "_yes" "")
(while
(setq ocolor (getvar "cecolor")
oltype (getvar "celtype")
odimcen (getvar "dimcen")
)
(setvar "cecolor" "1")
(setvar "celtype" "CENTER")
(setvar "dimcen" -2)
(command "dimcenter" pause)
(setvar "cecolor" ocolor)
(setvar "celtype" oltype)
(setvar "dimcen" odimcen)
);while
(princ)
)
(princ)
Here is a simple trick to store, set, and recall a list of system variables. (probably found on here)Code - Auto/Visual Lisp: [Select]
) ) )
Your error handler will restore the variables so all you have to do is invoke the error handler (which you can do with `QUIT`).
I have highlighted the lines that I changed.Code - Auto/Visual Lisp: [Select]
*error*) ) ) );while )
sorry ,this code has same result.
if i use CTR and missed click ,color and linetype has change old setting.
--->%
OK - It seems the DIMCENTER command doesn't like the (ssname ss n) input, so I altered this version to work like John's:
P.S. this version prevents missed picks from exiting the command.Code - Auto/Visual Lisp: [Select]
) ) ent ) ) ) )
thank you,i know can use entsel but if circle on block can not get info.
so i use pause,but click missed has go to error code.
cad "*^C^C_dimcenter " ← how to doing loop like this?
thank you,i know can use entsel but if circle on block can not get info.
so i use pause,but click missed has go to error code.
cad "*^C^C_dimcenter " ← how to doing loop like this?
Sorry - what your asking for cannot be done with the dimcenter command in a LISP as far as I can tell. I've tested it using (nentsel) to see the circle entity in the block, but it doesn't work. The "*^C^C_dimcenter " is a menu/toolbar macro and only works within that context - I recommend you stick with that. Better yet - switch to a custom centerline program such as:
http://www.lee-mac.com/centreline.html
P.S. if you upgrade your AutoCAD, it now has a built-in command called CENTERMARK that works better then dimcenter.
Sorry, just passing through but what is the goal?
Concept code below (nentsel finding circle in block):Code - Auto/Visual Lisp: [Select]
;; Prompts for an entity selection. ;; If there is already object selected, then returns the first ;; item in the selection set. ;; ;; EX: (getentsel) ;; RETURNS: ent (cond
Here is a simple trick to store, set, and recall a list of system variables. (probably found on here)Code - Auto/Visual Lisp: [Select]
) ) )
If your code use while loop,how can I use ESC end loop?
Hi,I just want to change setting and loop dimcenter.
but use lisp can not like "*^C^C_dimcenter " use on “circle” “arc” “circle or arc on block” and loop.
Hi,I just want to change setting and loop dimcenter.
but use lisp can not like "*^C^C_dimcenter " use on “circle” “arc” “circle or arc on block” and loop.
FWIW: I wrote a short program to replicate the DIMCENTER command. If this doesn't give you what you want I don't know what will:Code - Auto/Visual Lisp: [Select]
Hi,i have some question.
use your code can fix to get polyline arc center point? like dimcenter.
(defun c:CTR (/ *error* i cpt dc el ent vals vars _Entsel _StartUndo _EndUndo doc _MCS-to-WCS p1 p2 p3 p4 rad cens lttype censc_list cendd cenlt censc npt ep sp ept spt bu)
(defun *error* (msg)
(mapcar 'setvar vars vals)
(princ msg)
)
(defun _Nentsel (pr / ent)
(setvar "errno" 0)
(while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
(princ "\n->未選取,請再點選圓或弧:")
)
ent
)
(defun _MCS-to-WCS (pt mx)
(list
(+
(* (car (car mx)) (car pt))
(* (car (cadr mx)) (cadr pt))
(* (car (caddr mx)) (caddr pt))
(car (cadddr mx))
)
(+
(* (cadr (car mx)) (car pt))
(* (cadr (cadr mx)) (cadr pt))
(* (cadr (caddr mx)) (caddr pt))
(cadr (cadddr mx))
)
(+
(* (caddr (car mx)) (car pt))
(* (caddr (cadr mx)) (cadr pt))
(* (caddr (caddr mx)) (caddr pt))
(caddr (cadddr mx))
)
)
)
(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq vars '("cmdecho" "CELTSCALE" "cecolor" "celtype" "osmode")
vals (mapcar 'getvar vars)
)
(_StartUndo doc)
(setvar "cmdecho" 0)
(setq cens (getvar "CELTSCALE"))
(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)
(setq lttype (cdr (assoc 49 (tblsearch "ltype" "CENTER"))))
(if (or (= lttype 31.75) (= lttype 19.05) (= lttype 63.5))
(setq censc_list 50.8)
(setq censc_list (/ 50.8 25.4))
)
(mapcar 'setvar (cddr vars) '("1" "CENTER" 0))
(while (setq ent (_Nentsel "\n->請點選圓或弧或<退出>:"))
(setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
(cond
((wcmatch enm "ARC,CIRCLE")
(if (= (car (car (caddr ent))) (cadr (cadr (caddr ent))))
(progn
(if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (caddr ent)))(setq cpt (cdr (assoc 10 el))))
(if (car (car (caddr ent))) (setq rad (* (cdr (assoc 40 el)) (car (car (caddr ent))) ))
(setq rad (cdr (assoc 40 el))) )
(setq dc (/ (* rad 2) 20)
cendd (+ rad dc)
cenlt (getvar "LTSCALE")
censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
p1 (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
p3 (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
)
(setvar "CELTSCALE" censc)
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
(setvar "CELTSCALE" cens)
);progn
(princ "\n->選取的物件不是圓或弧或聚合線弧。")
);if
)
((= enm "LWPOLYLINE")
(setq obj (vlax-ename->vla-object (car ent))
npt (vlax-curve-getClosestPointTo obj (cadr ent))
ep (fix (vlax-curve-getEndParam obj))
)
(if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
(setq sp (1- sp))
(setq ep (1+ sp))
)
(setq spt (vlax-curve-getPointAtParam obj sp)
ept (vlax-curve-getPointAtParam obj ep)
)
(while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 0.0001)))
(setq el (cdr (member (Assoc 10 el) el)))
)
(setq bu (cdr (assoc 42 el)))
(if (or (/= bu 0) (> bu 0))
(progn
(setq ang (* 2.0 (atan bu))
rad (/ (distance spt ept) (* 2.0 (sin ang)))
;; Not sure whay below is not working to get center point.
;; cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
;; Hack to get the center point from the selected point on the poyline.
cpt (osnap npt "cen")
rad (abs rad)
dc (/ (* rad 2) 20)
cendd (+ rad dc)
cenlt (getvar "LTSCALE")
censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
p1 (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
p3 (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
)
(setvar "CELTSCALE" censc)
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
(setvar "CELTSCALE" cens)
);progn
(princ "\n->選取的物件不是圓或弧或聚合線弧。")
);if
)
(T (princ "\n->選取的物件不是圓或弧或聚合線弧。"))
);cond
);while
(mapcar 'setvar vars vals)
(_EndUndo doc)
(princ)
)
i use your new code fix,but POLYLINE Segment "block" can't get center point.
Quotei use your new code fix,but POLYLINE Segment "block" can't get center point.
I figured it out! Although this has become allot of code. I spent way too much time on this. I found out I had 2 mistakes:
1) I should have moved the entity list pointer 1 more time before getting the Bulge, that's why the math didn't work, I was getting the bulge for the segment before the one needed, and
2) In order for it to work in a block, you have to translate the point selected on the object from the UCS to the RCS (reference coordinate system), to find the segment point. For this I included a genius function made by another Swamp member - gile - that does the trick! I also had to translate the center point back to the WCS to properly place the centermark.
See updated code - sorry i did not use your code but used my original, so you will have to translate it again:Code - Auto/Visual Lisp: [Select]
(defun c:DCEN (/ *error* cpt dc el ent ep ept _Entsel i _MCS-to-WCS _TransNested npt obj p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 sp spt vals vars) ) ) ent ) (list (+ ) (+ ) (+ ) ) ) ;| Description: TransNested (original code by gile on TheSwamp.org) Translates a point coordinates from WCS or UCS to RCS -coordinates system of a reference (xref or block) whatever its nested level- |; ;; RefGeom (gile) ;; Returns: a list which first item is a 3x3 transformation matrix (rotation, ;; scales, normal) and second item the object insertion point in its parent ;; (xref, bloc or space) ;; Argument : an ename ) (list (setq mat (mxm '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) (mxm '(0.0 0.0 1.0) ) ) ) ) ) '- (mxv mat ) ) ) ) ;; RevRefGeom (gile) ;; RefGeom inverse function ) (list (setq mat (mxm ) (mxm '(0.0 0.0 1.0) ) '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) ) ) ) ) ) ) ) ;;; VXV Returns the dot product of 2 vectors ) ;; TRP Transpose a matrix -Doug Wilson- ) ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky- ) ;; MXM Multiply two matrices -Vladimir Nesterovsky- ) ;; Main Function. (while rlst ) ) ) ) ;; End Function (_TransNested) ) ) (cond ) ) ) ) ((= enm "LWPOLYLINE") ) ) ) ) ) ) ) ) ) ) ) ) ) )
That’s like a lot of work, just sayinCode - Python: [Select]
def PyRxCmd_doit(): try: es = Ed.Editor.entSel("\nSelect: ", Db.Polyline.desc()) if es[0] != Ed.PromptStatus.eOk: raise Exception("oof", es) pline = Db.Polyline(es[1]) compositeCurve = pline.getAcGeCurve() for curve in compositeCurve.getCurveList(): if curve.type() != Ge.EntityId.kCircArc3d: continue circArc = Ge.CircArc3d.cast(curve) Ed.Core.grDrawCircle(circArc.center(), 1, 24,1) except Exception as err: traceback.print_exception(err)
It's ok. thanks you so much.
(defun c:CTR (/ *error* i cpt dc el ent vals vars _Entsel _StartUndo _EndUndo doc _MCS-to-WCS p1 p2 p3 p4 rad cens lttype censc_list cendd cenlt censc npt ep sp ept spt bu)
(defun *error* (msg)
(_EndUndo doc)
(mapcar 'setvar vars vals)
(princ msg)
)
(defun _Nentsel (pr / ent)
(setvar "errno" 0)
(while (and (not (setq ent (nentsel pr)))(= (getvar "errno") 7))
(princ "\n->select circle:")
)
ent
)
(defun _MCS-to-WCS (pt mx)
(list
(+
(* (car (car mx)) (car pt))
(* (car (cadr mx)) (cadr pt))
(* (car (caddr mx)) (caddr pt))
(car (cadddr mx))
)
(+
(* (cadr (car mx)) (car pt))
(* (cadr (cadr mx)) (cadr pt))
(* (cadr (caddr mx)) (caddr pt))
(cadr (cadddr mx))
)
(+
(* (caddr (car mx)) (car pt))
(* (caddr (cadr mx)) (cadr pt))
(* (caddr (caddr mx)) (caddr pt))
(caddr (cadddr mx))
)
)
)
;| Description:
TransNested (original code by gile on TheSwamp.org)
Translates a point coordinates from WCS or UCS to RCS -coordinates system of a
reference (xref or block) whatever its nested level-
|;
(defun _TransNested (pt rlst from to / geom mxm mxv RefGeom RevRefGeom trp vxv)
;; RefGeom (gile)
;; Returns: a list which first item is a 3x3 transformation matrix (rotation,
;; scales, normal) and second item the object insertion point in its parent
;; (xref, bloc or space)
;; Argument : an ename
(defun RefGeom (ename / elst ang norm mat)
(setq elst (entget ename)
ang (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(list
(setq mat
(mxm
(mapcar (function (lambda (v) (trans v 0 norm T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list (list (cdr (assoc 41 elst)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 elst)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 elst)))
)
)
)
)
(mapcar
'-
(trans (cdr (assoc 10 elst)) norm 0)
(mxv mat
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst)))))
)
)
)
)
;; RevRefGeom (gile)
;; RefGeom inverse function
(defun RevRefGeom (ename / entData ang norm mat)
(setq entData (entget ename)
ang (- (cdr (assoc 50 entData)))
norm (cdr (assoc 210 entData))
)
(list
(setq mat
(mxm
(list (list (/ 1 (cdr (assoc 41 entData))) 0.0 0.0)
(list 0.0 (/ 1 (cdr (assoc 42 entData))) 0.0)
(list 0.0 0.0 (/ 1 (cdr (assoc 43 entData))))
)
(mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar (function (lambda (v) (trans v norm 0 T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
)
(mapcar '-
(cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 entData)))))
(mxv mat (trans (cdr (assoc 10 entData)) norm 0))
)
)
)
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
(apply '+ (mapcar '* v1 v2))
)
;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)
(apply 'mapcar (cons 'list m))
)
;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
(mapcar '(lambda (r) (vxv r v)) m)
)
;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)
;; Main Function.
(and (= 1 from) (setq pt (trans pt 1 0)))
(and (= 2 to) (setq rlst (reverse rlst)))
(and (or (= 2 from) (= 2 to))
(while rlst
(setq geom (if (= 2 to)(RevRefGeom (car rlst))(RefGeom (car rlst)))
rlst (cdr rlst)
pt (mapcar '+ (mxv (car geom) pt) (cadr geom))
)
)
)
(if (= 1 to)(trans pt 0 1) pt)
) ;; End Function (_TransNested)
(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq vars '("cmdecho" "CELTSCALE" "cecolor" "celtype" "osmode")
vals (mapcar 'getvar vars)
)
(setq cens (getvar "CELTSCALE"))
(setvar "cmdecho" 0)
(_StartUndo doc)
(if (= (tblsearch "ltype" "center") nil)
(vl-cmdf "_.-linetype" "_load" "center" "acadiso.lin" "")
)
(setq lttype (cdr (assoc 49 (tblsearch "ltype" "CENTER"))))
(if (or (= lttype 31.75) (= lttype 19.05) (= lttype 63.5))
(setq censc_list 50.8)
(setq censc_list (/ 50.8 25.4))
)
(mapcar 'setvar (cddr vars) '("1" "CENTER" 0))
(while (setq ent (_Nentsel "\n->select circle:"))
(setq enm (cdr (assoc 0 (setq el (entget (car ent))))))
(cond
((wcmatch enm "ARC,CIRCLE")
[color=red](if (= (car (car (caddr ent))) (cadr (cadr (caddr ent))))
(progn
(if (> (length ent) 2)(setq cpt (_MCS-to-WCS (cdr (assoc 10 el)) (cons (cons 0.0 (cons 0.0 (list 1.0))) (cons (cons 0.0 (cons (cdr (assoc 42 (entget (car (cadddr ent))))) (list 0.0))) (cons (cons (cdr (assoc 41 (entget (car (cadddr ent))))) (list 0.0 0.0)) (list (cadddr (caddr ent))) ))) ))(setq cpt (cdr (assoc 10 el))))
(if (and (car (car (caddr ent))) (and (= (cdr (assoc 41 (entget (car (cadddr ent))))) (cdr (assoc 42 (entget (car (cadddr ent))))) ) (= (cdr (assoc 41 (entget (car (reverse (cadddr ent)))))) (cdr (assoc 42 (entget (car (reverse (cadddr ent)))))) ) ));and
(progn
(if (> (length (cadddr ent)) 1)
(setq rad (* (cdr (assoc 40 el)) (cdr (assoc 41 (entget (car (cadddr ent))))) (cdr (assoc 41 (entget (car (reverse (cadddr ent)))))) ))
(setq rad (* (cdr (assoc 40 el)) (cdr (assoc 41 (entget (car (cadddr ent))))) ))
);if
);progn[/color]
(setq rad (cdr (assoc 40 el)))
);if
(setq dc (/ (* rad 2) 20)
cendd (+ rad dc)
cenlt (getvar "LTSCALE")
censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
p1 (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
p3 (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
)
(setvar "CELTSCALE" censc)
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
(setvar "CELTSCALE" cens)
);progn
(princ "\n->not circle。")
);if
)
((= enm "LWPOLYLINE")
(if (= (car (car (caddr ent))) (cadr (cadr (caddr ent))))
(progn
(setq obj (vlax-ename->vla-object (car ent))
npt (if (> (length ent) 2)
(vlax-curve-getClosestPointTo obj (_TransNested (cadr ent) (last ent) 1 2))
(vlax-curve-getClosestPointTo obj (cadr ent))
)
ep (fix (vlax-curve-getEndParam obj))
)
(if (= ep (setq sp (fix (vlax-curve-getParamAtPoint obj npt))))
(setq sp (1- sp))
(setq ep (1+ sp))
)
(setq spt (vlax-curve-getPointAtParam obj sp)
ept (vlax-curve-getPointAtParam obj ep)
)
(while (and el (not (equal (cdr (assoc 10 el)) (reverse (cdr (reverse spt))) 1e-6)))
(setq el (cdr (member (Assoc 10 el) el)))
)
(setq el (cdr (member (Assoc 10 el) el)))
(if (not (equal (setq bu (cdr (assoc 42 el))) 0.0 1e-6))
(progn
(setq ang (* 2.0 (atan bu))
rad (/ (distance spt ept) (* 2.0 (sin ang)))
cpt (polar spt (+ (- (/ pi 2.0) ang) (angle spt ept)) rad)
cpt (if (> (length ent) 2)(_MCS-to-WCS cpt (caddr ent)) cpt)
)
(if (car (car (caddr ent))) (setq rad (* (abs rad) (car (car (caddr ent))) ))
(setq rad (abs rad)) );if
(setq dc (/ (* rad 2) 20)
cendd (+ rad dc)
cenlt (getvar "LTSCALE")
censc (* (/ 1 cenlt) (/ (* cendd 2) censc_list))
p1 (list (car cpt) (+ (cadr cpt) cendd) (caddr cpt))
p2 (list (car cpt) (- (cadr cpt) cendd) (caddr cpt))
p3 (list (+ (car cpt) cendd) (cadr cpt) (caddr cpt))
p4 (list (- (car cpt) cendd) (cadr cpt) (caddr cpt))
)
(setvar "CELTSCALE" censc)
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
(entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 p4)))
(setvar "CELTSCALE" cens)
);progn
(princ "\n->not circle。")
);if
);progn
(princ "\n->not circle。")
);if
)
(T (princ "\n->not circle。"))
);cond
);while
(mapcar 'setvar vars vals)
(_EndUndo doc)
(princ)
)