Help me to fix an AutoCAD lisp to work with GstarCAD

November 12, 2023

Yep (getvar "useri1") = 0 so problem.

November 12, 2023

Hi BIGAL. Is not 0.

I use this code by default to set the scale

( DEFUN C:SETSC ()
  (setvar "OSMODE" 13)
  (setq cursc (getvar "useri1" ))
  (princ "\nThe Scale is 1:")(princ cursc)
  (setq newsc (getint "\nNew scale is  1:"))
  (setvar "useri1" newsc)
  (princ)
)

November 25, 2023

Hi BIGAL. I did all the changes but is not working. I get

Error: syntax error

Can you check the code?

For the scale i use this code

( DEFUN C:SETSC ()
  (setvar "OSMODE" 13)
  (setq cursc (getvar "useri1" ))
  (princ "\nThe Scale is 1:")(princ cursc)
  (setq newsc (getint "\nNew scale is  1:"))
  (setvar "useri1" newsc)
  (princ)
)

But I work in Layout the most of the times

(defun aH:getatt (blk tagn)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]


(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))


;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq
      (repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
     ;(setq str (getpropertyvalue (car blklist) "POINT")); the first one
	  (ah:getatt (car blklist) "POINT")) ; the first one
      (foreach blk (cdr blklist); the rest
     ;(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
	  (setq str (strcat str " - " (ah:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )



    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

And the version with scale blocks when i select the first point gives me the error

Error: invalid argument type: stringp:

(defun aH:getatt (blk tagn)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================


;;;;----;;;;
(princ "\nOK To Here, No. 1")
;;;;----;;;;




;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq



;;;;----;;;;
(princ "\nOK To Here, No. 2")
;;;;----;;;;

(repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      ;(setq str (getpropertyvalue (car blklist) "POINT")); the first one
	  (ah:getatt (car blklist) "POINT")) ; the first one
      (foreach blk (cdr blklist); the rest
      ;(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
	  (setq str (strcat str " - " (ah:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   ;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) ;  second change Steven P 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

Any ideas?

Thanks

Edited November 25, 2023 by mhy3sx

November 25, 2023

I update the code. Now insert the text but the numbers are random and with wrong angle !!!

;(defun aH:getatt (blk tagn)
;(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
;(foreach att atts
;(if (= (vla-get-tagstring att) tagn)
;(setq str (vla-get-textstring att))
;)
;)
;(princ)
;)

(defun aH:getatt (blk tagn / atts str)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
str
)


(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]


(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))


;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq
      (repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
     ;(setq str (getpropertyvalue (car blklist) "POINT")); the first one
	  (setq str (ah:getatt (car blklist) "POINT")) ; the first one
      (foreach blk (cdr blklist); the rest
     ;(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
	  (setq str (strcat str " - " (ah:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " sq.m"))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )



    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if



;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

November 26, 2023

I update this line

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

with

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 100 str ""
        "_.move" "_last" "" "@" pause
      )

The text is correct but vertical !!!! How to fix the code to insert the text correct? Any ideas?

Thanks

November 26, 2023

I fix it. I change the units settings !!!!

Thansk

Sign In

Help me to fix an AutoCAD lisp to work with GstarCAD

Recommended Posts

BIGAL

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhy3sx

BIGAL

Posted Images

mhy3sx

mhy3sx

mhy3sx

mhy3sx

mhy3sx

Join the conversation

mhy3sx

BIGAL

Tutorials

Forums

Activity